rlang/0000755000176200001440000000000013242771563011367 5ustar liggesusersrlang/tests/0000755000176200001440000000000013242736425012527 5ustar liggesusersrlang/tests/testthat.R0000644000176200001440000000007213241233650014500 0ustar liggesuserslibrary("testthat") library("rlang") test_check("rlang") rlang/tests/testthat/0000755000176200001440000000000013242771563014371 5ustar liggesusersrlang/tests/testthat/test-encoding.R0000644000176200001440000000166413241233650017253 0ustar liggesuserscontext("encoding") test_that("can roundtrip symbols in non-UTF8 locale", { with_non_utf8_locale({ expect_identical( as_string(sym(get_alien_lang_string())), get_alien_lang_string() ) }) }) test_that("Unicode escapes are always converted to UTF8 characters on roundtrip", { expect_identical( as_string(sym("")), "\u5E78\u798F" ) }) test_that("Unicode escapes are always converted to UTF8 characters in as_list()", { with_non_utf8_locale({ env <- child_env(empty_env()) env_bind(env, !! get_alien_lang_string() := NULL) list <- as_list(env) expect_identical(names(list), get_alien_lang_string()) }) }) test_that("Unicode escapes are always converted to UTF8 characters with env_names()", { with_non_utf8_locale({ env <- child_env(empty_env()) env_bind(env, !! get_alien_lang_string() := NULL) expect_identical(env_names(env), get_alien_lang_string()) }) }) rlang/tests/testthat/test-utils.R0000644000176200001440000000126113241233650016616 0ustar liggesuserscontext("utils") test_that("locale setters report old locale", { tryCatch( old <- suppressMessages(mut_mbcs_locale()), warning = function(e) skip("Cannot set MBCS locale") ) mbcs <- suppressMessages(mut_latin1_locale()) suppressMessages(Sys.setlocale("LC_CTYPE", old)) expect_true(tolower(mbcs) %in% tolower(c("ja_JP.SJIS", "English_United States.932"))) }) old_digits <- getOption("digits") test_that("scoped_options() sets options", { old <- scoped_options(digits = 2L) expect_identical(old$digits, old_digits) expect_identical(getOption("digits"), 2L) }) test_that("scoped_options() restores options", { expect_identical(getOption("digits"), old_digits) }) rlang/tests/testthat/test-sym.R0000644000176200001440000000175113241233650016272 0ustar liggesuserscontext("sym") test_that("ensym() fails with calls", { capture_sym <- function(arg) ensym(arg) expect_identical(capture_sym(foo), quote(foo)) expect_error(capture_sym(foo(bar)), "Must supply a symbol") }) test_that("ensym() supports strings and symbols", { capture_sym <- function(arg) ensym(arg) expect_identical(capture_sym("foo"), quote(foo)) expect_identical(capture_sym(!!"foo"), quote(foo)) expect_identical(capture_sym(!!sym("foo")), quote(foo)) }) test_that("empty string is treated as the missing argument", { expect_identical(sym(""), missing_arg()) }) test_that("syms() supports symbols as well", { expect_identical(syms(list(quote(a), "b")), list(quote(a), quote(b))) }) test_that("is_symbol() matches `name`", { expect_true(is_symbol(sym("foo"))) expect_true(is_symbol(sym("foo"), "foo")) expect_false(is_symbol(sym("foo"), "bar")) }) test_that("must supply strings to sym()", { expect_error(sym(letters), "strings") expect_error(sym(1:2), "strings") }) rlang/tests/testthat/test-dictionary.R0000644000176200001440000000315013241233650017622 0ustar liggesuserscontext("dictionary") test_that("can't access non-existent list members", { x1 <- list(y = 1) x2 <- as_dictionary(x1) expect_equal(x2$y, 1) expect_error(x2$z, "Object `z` not found in `.data`") expect_error(x2[["z"]], "Object `z` not found in `.data`") }) test_that("can't access non-existent environment components", { x1 <- list2env(list(y = 1)) x2 <- as_dictionary(x1) expect_equal(x2$y, 1) expect_error(x2$z, "Object `z` not found in environment") expect_error(x2[["z"]], "Object `z` not found in environment") }) test_that("can't use non-character vectors", { x <- as_dictionary(list(y = 1)) expect_error(x[[1]], "with a string") expect_error(x[[c("a", "b")]], "with a string") }) test_that("subsetting .data pronoun fails when not supplied", { f <- quo(.data$foo) expect_error(eval_tidy(f), "not found in `.data`") }) test_that("names() and length() methods", { x <- as_dictionary(mtcars) expect_identical(names(x), names(mtcars)) expect_identical(length(x), length(mtcars)) }) test_that("can replace elements of dictionaries", { expect_src <- function(dict, expected) { src <- .subset2(dict, "src") expect_identical(src, expected) } x <- as_dictionary(list(foo = "bar")) x$foo <- "baz" expect_src(x, list(foo = "baz")) x[["bar"]] <- "bam" expect_src(x, list(foo = "baz", bar = "bam")) expect_error(x[[3]] <- NULL, "with a string") }) test_that("cannot replace elements of read-only dictionaries", { x <- as_dictionary(list(foo = "bar"), read_only = TRUE) expect_error(x$foo <- "baz", "Can't modify") expect_error(x[["foo"]] <- "baz", "Can't modify") }) rlang/tests/testthat/fixtures/0000755000176200001440000000000013241233650016227 5ustar liggesusersrlang/tests/testthat/fixtures/rlanglibtest/0000755000176200001440000000000013241233650020721 5ustar liggesusersrlang/tests/testthat/fixtures/rlanglibtest/tests/0000755000176200001440000000000013241233650022063 5ustar liggesusersrlang/tests/testthat/fixtures/rlanglibtest/tests/testthat.R0000644000176200001440000000011013241233650024036 0ustar liggesuserslibrary("testthat") library("rlanglibtest") test_check("rlanglibtest") rlang/tests/testthat/fixtures/rlanglibtest/tests/testthat/0000755000176200001440000000000013242771563023736 5ustar liggesusersrlang/tests/testthat/fixtures/rlanglibtest/tests/testthat/test-quo-accessors.R0000644000176200001440000000140113241233650027606 0ustar liggesuserscontext("quo_accessors") test_that("r_quo_get_expr() gets expression", { r_quo_get_expr <- function(quo) { .Call(rlanglibtest_r_quo_get_expr, quo) } r_quo_set_expr <- function(quo, expr) { .Call(rlanglibtest_r_quo_set_expr, quo, expr) } r_quo_get_env <- function(quo) { .Call(rlanglibtest_r_quo_get_env, quo) } r_quo_set_env <- function(quo, env) { .Call(rlanglibtest_r_quo_set_env, quo, env) } quo <- rlang::quo(foo) expect_identical(r_quo_get_expr(quo), rlang::quo_get_expr(quo)) expect_identical(r_quo_get_env(quo), rlang::quo_get_env(quo)) expect_identical(r_quo_set_expr(quo, NULL), rlang::quo_set_expr(quo, NULL)) expect_identical(r_quo_set_env(quo, rlang::empty_env()), rlang::quo_set_env(quo, rlang::empty_env())) }) rlang/tests/testthat/fixtures/rlanglibtest/src/0000755000176200001440000000000013241233650021510 5ustar liggesusersrlang/tests/testthat/fixtures/rlanglibtest/src/Makevars0000644000176200001440000000003013241233650023175 0ustar liggesusersPKG_CPPFLAGS = -I./lib/ rlang/tests/testthat/fixtures/rlanglibtest/src/test-quo-accessors.c0000644000176200001440000000056313241233650025424 0ustar liggesusers#include "lib/rlang.h" sexp* rlanglibtest_r_quo_get_expr(sexp* quo) { return r_quo_get_expr(quo); } sexp* rlanglibtest_r_quo_set_expr(sexp* quo, sexp* expr) { return r_quo_set_expr(quo, expr); } sexp* rlanglibtest_r_quo_get_env(sexp* quo) { return r_quo_get_env(quo); } sexp* rlanglibtest_r_quo_set_env(sexp* quo, sexp* env) { return r_quo_set_env(quo, env); } rlang/tests/testthat/fixtures/rlanglibtest/src/init.c0000644000176200001440000000153013241233650022616 0ustar liggesusers#include "lib/rlang.h" extern sexp* rlanglibtest_r_quo_get_expr(sexp*); extern sexp* rlanglibtest_r_quo_set_expr(sexp*, sexp*); extern sexp* rlanglibtest_r_quo_get_env(sexp*); extern sexp* rlanglibtest_r_quo_set_env(sexp*, sexp*); sexp* rlanglibtest_library_load() { r_init_library(); return r_null; } static const r_callable r_callables[] = { {"rlanglibtest_library_load", (r_fn_ptr) &rlanglibtest_library_load, 0}, {"rlanglibtest_r_quo_get_expr", (r_fn_ptr) &rlanglibtest_r_quo_get_expr, 1}, {"rlanglibtest_r_quo_set_expr", (r_fn_ptr) &rlanglibtest_r_quo_set_expr, 2}, {"rlanglibtest_r_quo_get_env", (r_fn_ptr) &rlanglibtest_r_quo_get_env, 1}, {"rlanglibtest_r_quo_set_env", (r_fn_ptr) &rlanglibtest_r_quo_set_env, 2}, {NULL, NULL, 0} }; void R_init_rlanglibtest(r_dll_info* dll) { r_register_r_callables(dll, r_callables); } rlang/tests/testthat/fixtures/rlanglibtest/NAMESPACE0000644000176200001440000000013413241233650022136 0ustar liggesusers# Generated by roxygen2: do not edit by hand useDynLib(rlanglibtest, .registration = TRUE) rlang/tests/testthat/fixtures/rlanglibtest/R/0000755000176200001440000000000013241233650021122 5ustar liggesusersrlang/tests/testthat/fixtures/rlanglibtest/R/rlanglibtest.R0000644000176200001440000000032013241233650023732 0ustar liggesusers#' @useDynLib rlanglibtest, .registration = TRUE NULL .onLoad <- function(lib, pkg) { # Causes rlang package to load and register native routines rlang::dots_list() .Call(rlanglibtest_library_load) } rlang/tests/testthat/fixtures/rlanglibtest/DESCRIPTION0000644000176200001440000000052113241233650022425 0ustar liggesusersPackage: rlanglibtest Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: 'Lionel Henry [aut, cre]' Description: What the package does (one paragraph). Depends: R (>= 3.1.0) Imports: rlang LinkingTo: rlang License: GPL-3 Encoding: UTF-8 LazyData: true RoxygenNote: 6.0.1 rlang/tests/testthat/fixtures/lib.zip0000644000176200001440000006053013241233650017525 0ustar liggesusersPK(L lib.cuAn }Na$':un_i6+@mA(')J{*PA<2AR$ ~qa}6x+X+|VА{+ h𠔱`%pȑп&*1Zݱ֢؉4D6'RG_q4qpTQGK#ʌ1vjoi裡+oKR(z3qqAPK (Llib/PKe(Li'C lib/attrs.cS]O0}KZeTcL(ʲg&Dò!4i)8\"nI=92M>ҠL!d%jdrQ|Z SP–?JG!N|O2ze먍AQ1Y؄B( 킼i4@1C 7A7&>Z7;OL4G¥ |[@?Iئ3 N/kpr_|t ,}3$))dˏ˹=#;u +xȅ ? p.q[TG Ji[sk7aBm 8ZScb/ǐW[WŲ^ byojsvmd:T՝ 4Ke&}ᢠn'dqbϪQiY3>I]?T7`Wuxh0gxպKrPKt$L Z{ lib/attrs.hn0w?I,@JC2;/(UŻccB$C7wϑ,U%$ _gYWT82fIAw- #qAd!Pn Rcxf.V<,8AoS|d:oԐDbOjeyDZLȅ K Ty*O*]`数?!aWW;-5|Dyҏrpu;Ox0n*d.PKt$L xR lib/cnd.cVo6~_qSFj4^_6yXS(ւ%&S);#)&~}_2)6@\.OVhſ+0l)0)!Yq $_h2^"˥._~N_Lg! cpû7#opȇ49++bt{"qCs%أ=\YjPx8#,8E@2SLqZ>=7p\ iژ lC8J<ĕS04J&Zƶsek_«֧-JGR$/6Zv]^ze`4\uwWi"W./' .…#Px7ҳz?ecaSo_,Ln?Lɀi7 Y&Xfݲ|]n иʲE lTY#P7+efyvv5HY]p|:3(AȰokq;Eڷ!۸"^t A-&ډmF7kAw3@]Zxv L=I_հ۽b:ꅏkӎ X"e>M3o޺oށ=6?PKt$LfX lib/cnd.hJ1C %[} RE*d7I؝,ɬ]l?̙Tr~#+qˆQhlh(<ʝ+cY^X4Wpc0eYr6?̝By7xLb7 =HZPe:JoN$ڶ$[Ų ƴ 3~?x|Yy'xM0m[ Map2Vd T"r7< i]5Ɣ2/1Dz{: >PKt$L%5P lib/debug.hSLKIMSqswqu uR e楢rŋ 2J 4H*5/%3 PKe(LDđk lib/env.cRN0WL~d6r|dZ2-if[ &qEG+]Z.Wͥ(?X^@&x4" -ѠiEV>k7 &KJ`Ww2S,;d$h@dJ[ yidrⅷ GwO$1@ꭰUqR;rsK*{?4 xHdZ XEZ|k%mc 䢮o۷JFKXix49)qimԌv~ m\cNBL[ط'hy& w gJ6(bZ061G<9s7q }0nOť*jThIr؜?PKe(LE lib/env.hSn0 +zqvsES$iОT٦-2eH`ؿiWl7|z|&+]\f)'N(ƒ\2QTD8u̍_dbM.@`&!nȥá|aj}9I^H^ʉrR):[Ln#~_ EZ-1].{kΨWN4f=> (2l< Q/*/}3XYCa׋lzrgoS8XԍFPZ` IgmAۀ@FxdGU<̣4 LQWľi=[ܮ>jVRtiek;. B_"Rӽ͊ b-4#—`X?Fׯ/CRUPK t$Lm lib/eval.c#include "rlang.h" PKt$LᣎFe lib/eval.hSLKIMSqsw sRd楢 rq$d&+d$S+ Ss4  QH+TRP(J-)-SJZs UNKLPKt$L ^E lib/export.cuS]k0}$P"¶ݠdoBeǫsm$k)ﻲ˺!s&1U0ѥ|ӓI=וnFiST8 ȜKUVJY,Q N7ugĮ8\sx!Kz.TlFY^ r/?s9xyueCx 2@n2PV_r`DT7׋z.j'YbYmbApCrSi]mʃ2LK*4ԗGsRE+gnM&,{&^dcq@>0g֘ B5젱,i88qH CuU gysߩvm8p\׆>7&(CN!Ew[TCPJl6W: |@qa'M0w,I)yY7:>jhc1wî*9:56MX[r8 zPKe(L@<.1 lib/export.hR]k0}ׯ(1`{s|t7-:&T:Q%#%O+;-E:s$Od6@-_'M&RתWF_~w*Z.Y4z"nnSaWo|/tJӡ/F[=5,$mdnVsuJg Ѓ<ߦOK QgBDzt5A-dCH4VqekF;+||2͟8Kd4-KVAԚ\)v$G I9'M"ΈEE9FQF7& Ì2.i9*!yʗ()MaNCU#85E^pq ye9>=F\ͪͲp~Za5?OPKe(L-[;bslib/fn.hSLKIMSqswR3RKK22r@RũZ EiyI)~B5BQjIiQKdkD@F5W- Լ4.PKf`%L5w lib/formula.cTk0_q8Ŕ-}q tl p[9HrRҿ}/XG}ܝM3_\`0t(ehCxT"U+Z!%0}y-T9> F9,6+YXx2jJ".O9YRcx9 'aC'jI5h*)m@؁XyRC`4|IcYp[R΁/A&o$t\$`Osf+x P_;[+%jf*T 7f5Þa#(xu:m;^x}H7ey~cj^JU' Z2Ty2!23* +ob_]a$m"3:ٸ=NbEހapOhU"$yۮ'ɲ'ʆY{kO+I^+2^aOdr= | &@UĖ^ F0 :a;l6f[5d4CZ^+uў?,5ы\&LG6v[ZfCZVvvKZX(fó= co[0 lB얝gV!'_42Ywoܾ/i}]k|]ˏ\kTn?&#hfZt8z'EdJ攓xpC֣7EAO1 R#G{ ͎Mv8D"?KUELC oIrg?>UGVv,zn=r$1jPKt$LG/Uf lib/lang.hRO0xaJ&%AOMi;iR"v8\}?ޚ\sJ|Ej.Dj*.` .WuIRbS->JuQ+DFhDB[1{:TyYTn1˦x?~<[4{`?B<dex; u34,RWQ{QO^Ri^y|1i"AE 205qTW-fH=+0ۛbM3nQu*ҚɃ!5tz*Z'㘶}\uuwLjVC]PaED[")[#0 ItꍕCIx&i02P!WVF EϜɀV>71*l;9V=_\J}_xh%@?,Mepi573\M>36,y']? (ovT(BG _߅wYbiE ׇMJY2AZަQQ2'ދ{gٴMhA)0F_l;u4ǿ(\̫GZr%k g*3;O]L rfF/ <ʒJۑe`424wozIGsQc'Z<G_#nrCc% 84 6hjw)lMYEa sQ^S l 8WXe?Թ@9  nG!MG|)$QΉo[MxNX` t/8S;1"A*'|\F&l^XBC,0h<_08ԩq$SI{-2®{EKzkeq ?7 Ky%iNyET%y rg%\ԧMzؐ~HHy@I$5븗`ZYH%bFZo\/UGy)<{y9 ~¬>O^g:\ͺ۩7!`g:!\Y݃DO#H qstz Gyww n܅3X썒9 HpK'Nc{r.:b~|?n[ -dBj&0b5ciA bI!%Mr TGwbASotj Qq'Ɖ>mDvmq +O]٫"29$(10.#h#k !p8_H^&^1)??PKY&LHh lib/parse.hVmoF_1Rt B)::6gUU^Uͮ^'N;kx<󲳳\-m-ܴ~ѽ[^-.rܠ,UpZ(X>5-Ra}`T,CP-# [{UՃ[MW@wm"Z_wntyV ,AZۑfgPk ao::ˏ1 pk8kWY{wґ O9:e1j?buOٿw+G7~T?܊߇qy7PKt$L` lib/sexp.c}Pn0G*B:GA6$b8ّ*޽&7cf(j=ԉH9J{O4xLv@.cH#l;w)rSh&2ӀRf w| AjCy~F4, q꺆)[,@9>l8QTycWg8"Sa=xEM.7$%>Gfk?5WTjt Z. lib/sexp.hMs0 bgie] BJ hQE"[H4\y[v^㡒ӆ Ѵ";ojܼŷ26_k9z}m.'~t>o=*湞͎G [` PKt$L8ni lib/squash.cY[o6~`\ [M#Md[TZc2QnE$qR`/C]Q也|Tq՜̩y%]R^O}]9[R*S!2-,UD`aV9tJ^3U\ܐ(R  \/\̇JsRTa0eE%20s^: 6 Z-Mj$b98%ϯ>]- *-_+yJQAf@G\B09:%$tV9C:ičZZX\R;ap,'7y;gA/xrxsTAl`2g.PQ9&$t7), c$884I#G䵵0h4\k3v/, &3$m-X݈HI*10&}c ,ϖT šA(&2qpa;v:2]T _ӫ量]A (+0~8m-qbg xh@K= I7 a?)+?t(a%N9viĨ6t /o=ЙkZkʰ/7;BuS/La+V^ٮ1}BTܫ,ZF7$ 摰3ɡqXAO_Mc: p뾸H{pB x֒UO!t- >Rb>TV7us\J6SUEru 3 tDż'[;YKG1"(|b'dDdb$We=r)3G EEӋPUyU -[ 0T9Դ`!P%k ]O`Bҵj`'9GUx(c+<6@I3nAK%sNN$_UW褷iy(4Z$oK_>|& 9\(4/dQLB٠?>6<,xl;ߠA?$Hw8z_ ~ME0~b;uZcc rF0lIshӰhLxU&[ /*I!&/f4'*2p(0mBtiYŀeR|eDPKpsK$6$,)@Y6wNXl‚CT;_7lлZ¸r5fYfHXpm &l5GkMN hߪidqIz02f>//,:Di]CaؙptRvSt[rӺ=f{ImOIJR1<uJㆰwŸx]uuCzzp(_ʥO2}O 'fSِȭPf{PKt$L(K  lib/stack.hm 0 y.;TSϥv)nlnuex "mI]_1˷b Q pkL,+7>vԷ 8eMI 0,TL֋77I4֣)YU]F+ÙDX qw@,D~!u=9EdK PKt$LWҭ} lib/state.h]1 0F]nNP^0^Br wcG}^AV 8d˸XTuY6e$'ʀ Nܙ.F>ё PKt$LF@elib/sym-unescape.cV[O#7~ϯ8J0If!i.m *E( ǓX Qe.w ds{2!bq|̏N&{G_$Y-9Uc.*JKngY dL(8TT(ޟN)sj%@UBU0^&" ;`+ D\Dh.l"~WKم;)N'߮Di"! d:LHK"TB4@TSkH7 ^16-% U@2$sK-H6R-BA{2x.2YP!@S[<( )C4x|c Q rMh5F;w.` x kfڦ'F',3 JͩѴ9 yY&$*/ox48WEcd"i&DW2Lh,=:E^["1aR Y%{y`q*kI܎QQVմa)Au$3?\]];L64G,u*rfv񶼞r-wsNsp ,QPR\엳˫rpuiJi㠐qSUz>x2xyFMbGyU5ux$ CYnzyxջOy?`%3Q RmƆ9%H ;-\3)bb."zԥaX{ur&ȵ2*?/k$\=R }BBy>긴^̘f MԨ>PHL&MF$c& Ж1(G]-le%YlZx|0]|6M!o[1' ^q:xYǤeʹ%#,Sܮuj_JSE m+3ًAm_MIMޕ"OipRzՎ^@m;?G~s} Oی{]cڙMXl0ڙ&qsuUF H֖k|Ucg ~@ODPfC.^ ^ k1,򀛋/Ք#t,,1X[=U_l]6|U_lmOL:V 4l$h A++dT]*c 팳)X?RdDvD-"Wt_nyx켝xb#+"ghvp NIβUp|PKe(LtVbH@ lib/sym.cTMo0WRJ)챔JZi{hUQ*ׄX26WWIN{y3S!:o^t;͆U"5caI bIfh[ 6i0q3ԩ0ɤ_N`]Xj+uݪ kXĭ]m@k[i~B3OvHCxj d\<@(  Џ8B ۆh a<>,_OeEc$BE\B)Y^d\)riE G-Z;>%!8E2ȩfaX4FB7b(Hg:wNZM eY.=$*&mXL_h%v5E*'㇧㏠S S4TK.?3cE#9&<s%I'!-\^֗#RPL*ߢSpۇ_YmYa*fOq?.?{I)$~5;o2;\\ː{ nȼ~˵939ꍴF/Q wPKe(La( lib/sym.h}j0yl7p%C-tb$UJ߽Sbv'9+iyA"l4uX+fm޹`5Z )5;y8jELy"зqȀphb 9 ;":*T0oO \g5JE}B~djZO)! 7!ffwҎjݖsɕe[C+s Brt{v  sKv S t~.JPKe(LY lib/vec-chr.cSk0~_qM_Č͠ w8}*Rɲl0$ٮiaIH;6pX#ݻ}t޿͌biEQ# 0tJS^0øJ7} =@HZ P-~Ӄ2d{m_ K@u)O~IMxZ^2u6aRPb+[~jBԞn`/}SV/'\5PKe(L9 lib/vec-chr.hTQk0~6PbFePBXI6&T[NDHHd)8mw}I#^Z><~!?ͷ-Vd0:F\de3ba9"pQ*AHfXC}FF 藚UE֛ItJdd˴¿aD+>_nCxH 8+-o{ڞѹ+s;MY0ct}kBPzrBLMwUA3C|{XCGP̕sR혷G3۰9QKUBi0{<I2%܃śZB0yzZ\PHn0dO- fػ*qbDH-YD;$!fhZ ڵ~&?1gl_,z< \6'ݝT wHҮbZ6̚mEPKt$L lib/vec-lgl.cePK0~_q0ځZ !|DB]‘4mKqBHf5I0vC!uY4uM9'`W aXy܁RiZ,gg1 a̠|<ޯK(}4,QDhE疩i~@Q0YDGcHEN-cxlw=^64;`1"rb SQ\)#?ߝ<Ă;XmD~PKt$LPf lib/vec-lgl.hSLKIMSqssuqRgbJQ(O,4S+ *42J %y9 rsJ`3KJS4sq)dqPKt$LPFlib/vec-list.c}0D ^!F#^i Pȶ(Tѓ鼙QpFH cدhu< TgUKZ-d;8 qei4KwW>6;_nZI吖ej8bT<hB7 .^PKt$L]ޭ0lib/vec-list.hu 0Eݴ%JP6v5-IԢ{ǥ.$^>Q6j^WuYW=cmB4bԑ?)C hQ,`b6UnH#+0>'q+0u2.KxPKe(L~߱NF lib/vec.cWo6~_qNnv!3( h,$-(2F PbyS m|jnZS311Q|ɒ@b|mL%@j|=!Bt]^]`8ݿxTKAZĚvCJgdތdܼmz6ȄdDiqFZ)<^3tDH+:ŎkQ,m%h(`gifljA Y!e<*ht;8 Ю %ކFcfYoGAu!2+_+"7$ 4P/+i~Sߌ08*A3&U#Ў+chDq3\ߗ`-K B\ +Akߚ)~= \چ)0qt)h~ }GZRq|պfÒmg;|-s{濴vwO_$(ä&df ďlMh?% ͿR 5K "K%=u)jPX z!.yփ cSuGD;gmGsTPr<ߊfSfF^#*n'_4Ur&|h}?wW5oX2(cB< D<=u[-uSha@.6a40:&p{@lGXmWlx|t/Wwe iIv#}PGګ+)n)25wLA\j:/ 9<f4}(uÚNǚrnFHKp~sNm& ;{U}m1ՓZ_ "D5b4ce6I,i-}&?IFR4gGMTfҩm7 jlQOK 'X RzC^7w 8GД$z2ؤIЫ)WۧU5ރa48@A=FZ!>P*aϨ|RѐWQ۪|ܯPKe(Lh;t& lib/vec.hR]k0}ϯ ga q8ė1BojXL$N7KLmn -瞏۴W38ݍdڿ<|M(2Ċ F$ 5\uzZD :tڜmYF%5:,% %CQ'JN؜O2#v ' n}-.!@nhԙo %`5{L&RSE;vT~ʼn/1 L|8|8?߼ԤR}@qE8t|C*f0&o~kt?G{Db,.u ܛ՜[pWv{F/J9' JHt"r7tQo!eE-P3PK(L lib.cPK (LAlib/PKe(Li'C lib/attrs.cPKt$L Z{ Flib/attrs.hPKt$L xR flib/cnd.cPKt$LfX  lib/cnd.hPKt$L%5P G lib/debug.hPKe(LDđk  lib/env.cPKe(LE ] lib/env.hPK t$Lm @lib/eval.cPKt$LᣎFe {lib/eval.hPKt$L ^E lib/export.cPKe(L@<.1 !lib/export.hPKe(L-[;bslib/fn.hPKf`%L5w lib/formula.cPKt$Lx} Glib/formula.hPKf`%LGT lib/lang.cPKt$LG/Uf klib/lang.hPKf`%LXA lib/node.cPKf`%Lvd blib/node.hPKY&LHS0 lib/parse.cPKY&LHh B&lib/parse.hPK(LM )lib/quo.cPK(L]Df r*lib/quo.hPKt$Lr *lib/replace-na.cPK(LVYAa K-lib/rlang.hPKt$L` 0lib/sexp.cPKe(L@N> 2lib/sexp.hPKt$L8ni 4lib/squash.cPKt$LQ <lib/squash.hPKt$Lg^ E=lib/stack.cPKt$L(K  >lib/stack.hPKt$LWҭ} ?lib/state.hPKt$LF@eH@lib/sym-unescape.cPKe(LtVbH@ Elib/sym.cPKe(La( 'Hlib/sym.hPKe(LY vIlib/vec-chr.cPKe(L9 Klib/vec-chr.hPKt$L Mlib/vec-lgl.cPKt$LPf #Olib/vec-lgl.hPKt$LPFOlib/vec-list.cPKt$L]ޭ0Plib/vec-list.hPKe(L~߱NF xQlib/vec.cPKe(Lh;t& Ulib/vec.hPK,, Wrlang/tests/testthat/test-sexp.R0000644000176200001440000000037313241233650016440 0ustar liggesuserscontext("sexp") test_that("poke_type() changes object type", { x <- new_node(quote(foo), NULL) out <- withVisible(poke_type(x, "language")) expect_false(out$visible) expect_identical(out$value, x) expect_identical(typeof(x), "language") }) rlang/tests/testthat/test-stack.R0000644000176200001440000002102113241233650016557 0ustar liggesuserscontext("evaluation frames") # --------------------------------------- # Beware some sys.x() take `n` and some take `which` test_that("ctxt_frame() caller agrees with sys.parent()", { parent <- sys.parent(n = 1) caller <- ctxt_frame()$caller_pos expect_equal(caller, parent) }) test_that("ctxt_frame() expr agrees with sys.call()", { n <- sys.nframe() syscall <- sys.call(which = n) expr <- ctxt_frame()$expr expect_identical(expr, syscall) frame <- identity(ctxt_frame()) expect_equal(frame$expr, quote(identity(ctxt_frame()))) }) test_that("ctxt_frame() env agrees with sys.frame()", { n <- sys.nframe() sysframe <- sys.frame(which = n) env <- ctxt_frame()$env expect_identical(env, sysframe) }) test_that("context position is correct", { pos1 <- identity(ctxt_frame()$pos) pos2 <- identity(identity(ctxt_frame()$pos)) pos1 <- fixup_ctxt_depth(pos1) expect_equal(pos1, 1) pos2 <- fixup_ctxt_depth(pos2) expect_equal(pos2, 2) }) test_that("ctxt_frame(n_depth) returns global frame", { n_depth <- ctxt_depth() frame <- ctxt_frame(n_depth) global <- global_frame() expect_identical(frame, global) }) test_that("call_depth() returns correct depth", { depth1 <- identity(call_depth()) expect_equal(fixup_call_depth(depth1), 0) f <- function() identity(call_depth()) g <- function() f() depth2 <- f() depth3 <- g() expect_equal(fixup_call_depth(depth2), 1) expect_equal(fixup_call_depth(depth3), 2) expect_equal(fixup_call_depth(f()), 1) expect_equal(fixup_call_depth(g()), 2) }) test_that("call_frame()$env is the same as parent.frame()", { f <- function(n) call_frame(n + 1)$env f_base <- function(n) parent.frame(n) env1 <- f(1) env1_base <- f_base(1) expect_identical(env1, env1_base) g <- function(n) list(f(n), f_base(n)) envs <- g(1) expect_identical(envs[[1]], envs[[2]]) }) test_that("call_frame()$expr gives expression of caller not previous ctxt", { f <- function(x = 1) call_frame(x)$expr expect_equal(f(), quote(f())) g <- function() identity(f(2)) expect_equal(g(), quote(g())) }) test_that("call_frame(n_depth) returns global frame", { n_depth <- call_depth() expect_identical(call_frame(n_depth), global_frame()) }) test_that("call_frame(n) throws at correct level", { n <- call_depth() expect_error(call_frame(n + 1), "not that many frames") }) test_that("call frames are cleaned", { ctxt_frame_messy <- eval(quote(call_frame(clean = FALSE)), new.env()) expect_identical(ctxt_frame_messy$fn, prim_eval) ctxt_frame_clean <- eval(quote(call_frame(clean = TRUE)), new.env()) expect_identical(ctxt_frame_clean$fn, base::eval) }) context("evaluation stacks") # --------------------------------------- test_that("ctxt_stack_callers() agrees with sys.parents()", { parents <- sys.parents() callers <- ctxt_stack_callers() expect_equal(callers, rev(parents)) }) test_that("ctxt_stack_exprs() agrees with sys.call()", { pos <- sys.nframe() syscalls <- map(seq(pos, 1), sys.call) exprs <- ctxt_stack_exprs() expect_identical(exprs, syscalls) }) test_that("ctxt_stack_envs() agrees with sys.frames()", { sysframes <- sys.frames() sysframes <- rev(as.list(sysframes)) envs <- ctxt_stack_envs() expect_identical(envs, sysframes) }) test_that("ctxt_stack_trail() returns a vector of size nframe", { trail <- ctxt_stack_trail() n <- sys.nframe() expect_equal(length(trail), n) }) test_that("ctxt_stack_fns() returns functions in correct order", { f1 <- function(x) f2(x) f2 <- function(x) ctxt_stack_fns() expect_identical(f1()[1:2], list(f2, f1)) }) test_that("ctxt_stack_fns() handles intervening frames", { fns <- ctxt_stack_fns() intervened_fns <- identity(identity(ctxt_stack_fns())) expect_identical(c(identity, identity, fns), intervened_fns) }) test_that("ctxt_stack() handles intervening frames", { stack <- ctxt_stack() intervened_stack <- identity(ctxt_stack())[-1] expect_identical(intervened_stack, stack) }) test_that("call_stack() trail ignores irrelevant frames", { f1 <- function(x) f2(x) f2 <- function(x) f3() f3 <- function(x) call_stack() stack1 <- f1() trail1 <- pluck_int(stack1, "pos") expect_equal(fixup_call_trail(trail1), c(3, 2, 1)) stack2 <- identity(identity(f1())) trail2 <- pluck_int(stack2, "pos") expect_equal(fixup_call_trail(trail2), c(5, 4, 3)) }) test_that("ctxt_stack() exprs is in opposite order to sys calls", { syscalls <- sys.calls() stack <- ctxt_stack() stack <- drop_last(stack) # global frame exprs <- pluck(stack, "expr") expect_equal(exprs[[length(exprs)]], syscalls[[1]]) expect_equal(exprs[[1]], syscalls[[length(syscalls)]]) }) test_that("ctxt_stack() and call_stack() agree", { call_stack <- call_stack() call_stack <- drop_last(call_stack) # global frame positions <- map_int(call_stack, `[[`, "pos") ctxt_stack <- ctxt_stack() ctxt_stack <- drop_last(ctxt_stack) # global frame ctxt_stack <- rev(ctxt_stack)[positions] call_exprs <- map(call_stack, `[[`, "expr") eval_exprs <- map(ctxt_stack, `[[`, "expr") expect_identical(call_exprs, eval_exprs) is_eval <- map_lgl(call_stack, function(frame) { identical(frame$fn, base::eval) }) call_envs <- map(call_stack[!is_eval], `[[`, "env") eval_envs <- map(ctxt_stack[!is_eval], `[[`, "env") expect_identical(call_envs, eval_envs) }) test_that("ctxt_stack() subsets n frames", { stack <- ctxt_stack() stack_2 <- ctxt_stack(2) expect_identical(stack_2, stack[1:2]) n <- ctxt_depth() stack_n <- ctxt_stack(n) expect_identical(stack_n, stack) # Get correct eval depth within expect_error() expect_error({ n <- ctxt_depth(); stop() }) expect_error(ctxt_stack(n + 1), "not that many frames") }) test_that("call_stack() subsets n frames", { stack <- call_stack() stack_2 <- call_stack(2) expect_identical(stack_2, stack[1:2]) n <- call_depth() stack_n <- call_stack(n) expect_identical(stack_n, stack) # Get correct eval depth within expect_error() expect_error({ n <- call_depth(); stop() }) expect_error(call_stack(n + 1), "not that many frames") }) test_that("call stacks are cleaned", { stack_messy <- eval(quote(call_stack(clean = FALSE)), new.env())[1:2] expect_identical(stack_messy[[1]]$fn, prim_eval) expect_identical(stack_messy[[2]]$fn, base::eval) stack_clean <- eval(quote(call_stack(clean = TRUE)), new.env()) expect_identical(stack_clean[[1]]$fn, base::eval) }) test_that("ctxt_stack() trims layers of calls", { current_stack <- ctxt_stack() expect_identical(identity(identity(ctxt_stack(trim = 1))), current_stack) fn <- function(trim) identity(identity(ctxt_stack(trim = trim))) stack <- identity(identity(fn(2))) expect_identical(stack, current_stack) }) context("frame utils") # --------------------------------------------- test_that("frame_position() returns correct position", { fn <- function() { env <- environment() pos <- ctxt_frame()$pos g(env, pos) } g <- function(env, fn_pos) { pos <- frame_position(env) expect_identical(pos, fn_pos) burried_pos <- identity(identity(frame_position(env))) expect_identical(burried_pos, pos) } fn() }) test_that("frame_position_current() computes distance from a frame", { fn <- function() { g(environment()) } g <- function(env) { distance <- frame_position(env, from = "current") frame <- ctxt_frame(distance) expect_identical(frame$env, env) burried_distance <- identity(frame_position(env, from = "current")) expect_equal(distance, burried_distance) } fn() }) test_that("evaluation stack is trimmed from layers of calls", { stack <- ctxt_stack() trimmed_stack <- identity(stack_trim(identity(ctxt_stack()))) expect_identical(stack, trimmed_stack) }) test_that("can return from frame", { fn <- function() { val <- g() paste(val, "to fn()") } g <- function(env) { h(environment()) stop("g!\n") } h <- function(env) { return_from(env, "returned from h()") stop("h!\n") } expect_equal(fn(), "returned from h() to fn()") }) test_that("can return to frame", { fn <- function() { val <- identity(g(environment())) paste(val, "to fn()") } g <- function(env) { h(env) stop("g!\n") } h <- function(env) { return_to(env, "returned from h()") stop("h!\n") } expect_equal(fn(), "returned from h() to fn()") }) test_that("detects frame environment", { expect_true(identity(is_frame_env(ctxt_frame(2)$env))) }) test_that("call is not modified in place", { f <- function(...) g(...) g <- function(...) call_stack()[1:2] stack <- f(foo) expect_equal(stack[[1]]$expr, quote(g(...))) }) rlang/tests/testthat/test-operators.R0000644000176200001440000000154413241233650017500 0ustar liggesuserscontext("operators") test_that("%|% returns default value", { lgl <- c(TRUE, TRUE, NA, FALSE) %|% FALSE expect_identical(lgl, c(TRUE, TRUE, FALSE, FALSE)) int <- c(1L, 2L, NA, 4L) %|% 3L expect_identical(int, 1:4) dbl <- c(1, 2, NA, 4) %|% 3 expect_identical(dbl, as.double(1:4)) chr <- c("1", "2", NA, "4") %|% "3" expect_identical(chr, as.character(1:4)) cpx <- c(1i, 2i, NA, 4i) %|% 3i expect_equal(cpx, c(1i, 2i, 3i, 4i)) }) test_that("%|% fails with wrong types", { expect_error(c(1L, NA) %|% 2) expect_error(c(1, NA) %|% "") }) test_that("%@% returns attribute", { expect_identical(mtcars %@% "row.names", row.names(mtcars)) expect_null(mtcars %@% "row") }) test_that("new_definition() returns new `:=` call", { def <- "foo" ~ "bar" node_poke_car(def, quote(`:=`)) expect_identical(new_definition("foo", "bar"), def) }) rlang/tests/testthat/test-dots.R0000644000176200001440000000751513241233650016437 0ustar liggesuserscontext("dots") test_that("exprs() without arguments creates an empty named list", { expect_identical(exprs(), named_list()) }) test_that("exprs() captures arguments forwarded with `...`", { wrapper <- function(...) exprs(...) expect_identical(wrapper(a = 1, foo = bar), list(a = 1, foo = quote(bar))) }) test_that("exprs() captures empty arguments", { expect_identical(exprs(, , .ignore_empty = "none"), set_names(list(missing_arg(), missing_arg()), c("", ""))) }) test_that("dots are always named", { expect_named(dots_list("foo"), "") expect_named(dots_splice("foo", list("bar")), c("", "")) expect_named(exprs(foo, bar), c("", "")) }) test_that("dots can be spliced", { spliced_dots <- dots_values(!!! list(letters)) expect_identical(spliced_dots, list(splice(list(letters)))) expect_identical(flatten(dots_values(!!! list(letters))), list(letters)) expect_identical(list2(!!! list(letters)), list(letters)) wrapper <- function(...) list2(...) expect_identical(wrapper(!!! list(letters)), list(letters)) }) test_that("interpolation by value does not guard formulas", { expect_identical(dots_values(~1), list(~1)) }) test_that("dots names can be unquoted", { expect_identical(dots_values(!! paste0("foo", "bar") := 10), list(foobar = 10)) }) test_that("can take forced dots with `allowForced = FALSE`", { fn <- function(...) { force(..1) captureDots() } expect_identical(fn(letters), list(list(expr = letters, env = empty_env()))) }) test_that("captured dots are only named if names were supplied", { fn <- function(...) captureDots() expect_null(names(fn(1, 2))) expect_identical(names(fn(a = 1, 2)), c("a", "")) }) test_that("dots_values() handles forced dots", { fn <- function(...) { force(..1) dots_values(...) } expect_identical(fn("foo"), list("foo")) expect_identical(lapply(1:2, function(...) dots_values(...)), list(list(1L), list(2L))) expect_identical(lapply(1:2, dots_values), list(list(1L), list(2L))) }) test_that("empty arguments trigger meaningful error", { expect_error(list2(1, , 3), "Argument 2 is empty") expect_error(dots_list(1, , 3), "Argument 2 is empty") }) test_that("cleans empty arguments", { expect_identical(dots_list(1, ), named_list(1)) expect_identical(list2(1, ), list(1)) expect_identical(exprs(1, ), named_list(1)) expect_identical(dots_list(, 1, , .ignore_empty = "all"), named_list(1)) }) test_that("doesn't clean named empty argument arguments", { expect_error(dots_list(1, a = ), "Argument 2 is empty") expect_identical(exprs(1, a = ), alist(1, a = )) expect_identical(exprs(1, a = , b = , , .ignore_empty = "all"), alist(1, a = , b = )) }) test_that("capturing dots by value only unquote-splices at top-level", { expect_identical_(dots_list(!!! list(quote(!!! a))), named_list(quote(!!! a))) expect_identical_(dots_list(!!! exprs(!!! 1:3)), named_list(1L, 2L, 3L)) }) test_that("can't unquote when capturing dots by value", { expect_identical(dots_list(!!! list(!!! TRUE)), named_list(FALSE)) }) test_that("can splice NULL value", { expect_identical(dots_list(!!! NULL), named_list()) expect_identical(dots_list(1, !!! NULL, 3), named_list(1, 3)) }) test_that("dots_splice() flattens lists", { expect_identical(dots_splice(list("a", list("b"), "c"), "d", list("e")), named_list("a", list("b"), "c", "d", "e")) expect_identical(dots_splice(list("a"), !!! list("b"), list("c"), "d"), named_list("a", "b", "c", "d")) expect_identical(dots_splice(list("a"), splice(list("b")), list("c"), "d"), named_list("a", "b", "c", "d")) }) test_that("dots_splice() doesn't squash S3 objects", { s <- structure(list(v1 = 1, v2 = 2), class = "foo") expect_identical(dots_splice(s, s), named_list(s, s)) }) test_that("dots_node() doesn't trim attributes from arguments", { x <- ~foo dots <- eval(expr(dots_node(!! x))) expect_identical(node_car(dots), x) }) rlang/tests/testthat/test-eval.R0000644000176200001440000000111413241233650016402 0ustar liggesuserscontext("invoke") test_that("invoke() buries arguments", { expect_identical(invoke(call_inspect, 1:2, 3L), quote(.fn(`1`, `2`, `3`))) expect_identical(invoke("call_inspect", 1:2, 3L), quote(call_inspect(`1`, `2`, `3`))) expect_identical(invoke(call_inspect, 1:2, 3L, .bury = c("foo", "bar")), quote(foo(`bar1`, `bar2`, `bar3`))) expect_identical(invoke(call_inspect, 1:2, 3L, .bury = NULL), as.call(list(call_inspect, 1L, 2L, 3L))) }) test_that("invoke() can be called without arguments", { expect_identical(invoke("list"), list()) expect_identical(invoke(list), list()) }) rlang/tests/testthat/test-formula.R0000644000176200001440000000566013241233650017132 0ustar liggesuserscontext("formula") # Creation ---------------------------------------------------------------- test_that("is_formula works", { expect_true(is_formula(~10)) expect_false(is_formula(10)) }) # Getters ----------------------------------------------------------------- test_that("throws errors for bad inputs", { expect_error(f_rhs(1), "must be a formula") expect_error(f_rhs(`~`()), "Invalid formula") expect_error(f_rhs(`~`(1, 2, 3)), "Invalid formula") expect_error(f_lhs(1), "must be a formula") expect_error(f_lhs(`~`()), "Invalid formula") expect_error(f_lhs(`~`(1, 2, 3)), "Invalid formula") expect_error(f_env(1), "must be a formula") }) test_that("extracts call, name, or scalar", { expect_identical(f_rhs(~ x), quote(x)) expect_identical(f_rhs(~ f()), quote(f())) expect_identical(f_rhs(~ 1L), 1L) }) # Setters ----------------------------------------------------------------- test_that("can replace RHS of one-sided formula", { f <- ~ x1 f_rhs(f) <- quote(x2) expect_equal(f, ~ x2) }) test_that("can replace both sides of two-sided formula", { f <- x1 ~ y1 f_lhs(f) <- quote(x2) f_rhs(f) <- quote(y2) expect_equal(f, x2 ~ y2) }) test_that("can remove lhs of two-sided formula", { f <- x ~ y f_lhs(f) <- NULL expect_equal(f, ~ y) }) test_that("can modify environment", { f <- x ~ y env <- new.env() f_env(f) <- env expect_equal(f_env(f), env) }) test_that("setting RHS preserves attributes", { attrs <- list(foo = "bar", class = "baz") f <- set_attrs(~foo, !!! attrs) f_rhs(f) <- quote(bar) expect_identical(f, set_attrs(~bar, !!! attrs)) }) test_that("setting LHS preserves attributes", { attrs <- list(foo = "bar", class = "baz") f <- set_attrs(~foo, !!! attrs) f_lhs(f) <- quote(bar) expect_identical(f, set_attrs(bar ~ foo, !!! attrs)) f_lhs(f) <- quote(baz) expect_identical(f, set_attrs(baz ~ foo, !!! attrs)) }) test_that("setting environment preserves attributes", { attrs <- list(foo = "bar", class = "baz") env <- env() f <- set_attrs(~foo, !!! attrs) f_env(f) <- env expect_identical(f, set_attrs(~foo, !!! attrs, .Environment = env)) }) # Utils -------------------------------------------------------------- test_that("quosures are not recognised as bare formulas", { expect_false(is_bare_formula(quo(foo))) }) test_that("lhs is inspected", { expect_true(is_formula(~foo)) expect_false(is_formula(~foo, lhs = TRUE)) expect_true(is_formula(~foo, lhs = FALSE)) expect_true(is_formula(foo ~ bar, lhs = TRUE)) expect_false(is_formula(foo ~ bar, lhs = FALSE)) }) test_that("definitions are not formulas but are formulaish", { expect_false(is_formula(quote(foo := bar))) expect_true(is_formulaish(quote(foo := bar), lhs = TRUE)) expect_false(is_formulaish(quote(foo := bar), lhs = FALSE)) `:=` <- `~` expect_false(is_formulaish(foo := bar, scoped = TRUE, lhs = FALSE)) expect_false(is_formulaish(foo := bar, scoped = FALSE, lhs = TRUE)) }) rlang/tests/testthat/test-arg.R0000644000176200001440000000210213241233650016222 0ustar liggesuserscontext("arg") test_that("matches arg", { myarg <- c("foo", "baz") expect_identical(arg_match(myarg, c("bar", "foo")), "foo") expect_error( regex = "`myarg` should be one of: \"bar\" or \"baz\"", arg_match(myarg, c("bar", "baz")) ) }) test_that("informative error message on partial match", { myarg <- "f" expect_error( regex = "Did you mean \"foo\"?", arg_match(myarg, c("bar", "foo")) ) }) test_that("gets choices from function", { fn <- function(myarg = c("bar", "foo")) arg_match(myarg) expect_error(fn("f"), "Did you mean \"foo\"?") expect_identical(fn("foo"), "foo") }) test_that("is_missing() works with symbols", { x <- missing_arg() expect_true(is_missing(x)) }) test_that("is_missing() works with non-symbols", { expect_true(is_missing(missing_arg())) l <- list(missing_arg()) expect_true(is_missing(l[[1]])) expect_error(missing(l[[1]]), "invalid use") }) test_that("maybe_missing() forwards missing value", { x <- missing_arg() expect_true(is_missing(maybe_missing(x))) expect_false(is_missing(maybe_missing(1L))) }) rlang/tests/testthat/helper-locale.R0000644000176200001440000000240213241233650017213 0ustar liggesusersget_lang_strings <- function() { lang_strings <- c( de = "Gl\u00fcck", cn = "\u5e78\u798f", ru = "\u0441\u0447\u0430\u0441\u0442\u044c\u0435", ko = "\ud589\ubcf5" ) native_lang_strings <- enc2native(lang_strings) same <- (lang_strings == native_lang_strings) list( same = lang_strings[same], different = lang_strings[!same] ) } get_native_lang_string <- function() { lang_strings <- get_lang_strings() if (length(lang_strings$same) == 0) testthat::skip("No native language string available") lang_strings$same[[1L]] } get_alien_lang_string <- function() { lang_strings <- get_lang_strings() if (length(lang_strings$different) == 0) testthat::skip("No alien language string available") lang_strings$different[[1L]] } with_non_utf8_locale <- function(code) { old_locale <- mut_non_utf8_locale() on.exit(mut_ctype(old_locale), add = TRUE) code } mut_non_utf8_locale <- function() { if (.Platform$OS.type == "windows") return(NULL) tryCatch( locale <- mut_ctype("en_US.ISO8859-1"), warning = function(e) { testthat::skip("Cannot set latin-1 locale") } ) locale } with_latin1_locale <- function(expr) { old_locale <- suppressMessages(mut_latin1_locale()) on.exit(mut_ctype(old_locale)) expr } rlang/tests/testthat/test-vec-utils.R0000644000176200001440000000117613241233650017376 0ustar liggesuserscontext("vec-utils") test_that("vector is modified", { x <- c(1, b = 2, c = 3, 4) out <- modify(x, 5, b = 20, splice(list(6, c = "30"))) expect_equal(out, list(1, b = 20, c = "30", 4, 5, 6)) }) test_that("are_na() requires vector input but not is_na()", { expect_error(are_na(base::eval), "must be a vector") expect_false(is_na(base::eval)) }) test_that("seq2() creates increasing sequences", { expect_identical(seq2(2, 3), 2:3) expect_identical(seq2(3, 2), int()) }) test_that("seq2_along() creates increasing sequences", { expect_identical(seq2_along(3, 1:2), int()) expect_identical(seq2_along(-1, 1:2), -1:2) }) rlang/tests/testthat/test-quasiquotation.R0000644000176200001440000003543313241252127020554 0ustar liggesuserscontext("quasiquotation") test_that("interpolation does not recurse over spliced arguments", { var2 <- quote({foo; !! stop(); bar}) expr_var2 <- tryCatch(expr(list(!!! var2)), error = identity) expect_false(inherits(expr_var2, "error")) }) test_that("formulas containing unquote operators are interpolated", { var1 <- quo(foo) var2 <- local({ foo <- "baz"; quo(foo) }) f <- expr_interp(~list(!!var1, !!var2)) expect_identical(f, new_formula(NULL, call2("list", as_quosure(var1), as_quosure(var2)))) }) test_that("interpolation is carried out in the right environment", { f <- local({ foo <- "foo"; ~!!foo }) expect_identical(expr_interp(f), new_formula(NULL, "foo", env = f_env(f))) }) test_that("interpolation now revisits unquoted formulas", { f <- ~list(!!~!!stop("should not interpolate within formulas")) f <- expr_interp(f) # This used to be idempotent: expect_error(expect_false(identical(expr_interp(f), f)), "interpolate within formulas") }) test_that("formulas are not treated as quosures", { expect_identical(expr(a ~ b), quote(a ~ b)) expect_identical(expr(~b), quote(~b)) expect_identical(expr(!!~b), ~b) }) test_that("unquote operators are always in scope", { env <- child_env("base", foo = "bar") f <- with_env(env, ~(!!foo)) expect_identical(expr_interp(f), new_formula(NULL, "bar", env)) }) test_that("can interpolate in specific env", { foo <- "bar" env <- child_env(NULL, foo = "foo") expanded <- expr_interp(~!!foo) expect_identical(expanded, set_env(~"bar")) expanded <- expr_interp(~!!foo, env) expect_identical(expanded, set_env(~"foo")) }) test_that("can qualify operators with namespace", { with_non_verbose_retirement({ # Should remove prefix only if rlang-qualified: expect_identical(quo(rlang::UQ(toupper("a"))), new_quosure("A", empty_env())) expect_identical(quo(list(rlang::UQS(list(a = 1, b = 2)))), quo(list(a = 1, b = 2))) # Should keep prefix otherwise: expect_identical(quo(other::UQ(toupper("a"))), quo(other::"A")) expect_identical(quo(x$UQ(toupper("a"))), quo(x$"A")) }) }) test_that("unquoting is frame-consistent", { defun <- quote(!! function() NULL) env <- child_env("base") expect_identical(fn_env(expr_interp(defun, env)), env) }) test_that("unquoted quosure has S3 class", { quo <- quo(!! ~quo) expect_is(quo, "quosure") }) test_that("unquoted quosures are not guarded", { quo <- eval_tidy(quo(quo(!! ~quo))) expect_true(is_quosure(quo)) }) # !! ---------------------------------------------------------------------- test_that("`!!` binds tightly", { expect_identical_(expr(!!1 + 2 + 3), quote(1 + 2 + 3)) expect_identical_(expr(1 + !!2 + 3), quote(1 + 2 + 3)) expect_identical_(expr(1 + 2 + !!3 + 4), quote(1 + 2 + 3 + 4)) expect_identical_(expr(1 + !!(2) + 3), quote(1 + 2 + 3)) expect_identical_(expr(1 + 2 + !!3), quote(1 + 2 + 3)) expect_identical_(expr(1 + !!2 * 3), quote(1 + 2 * 3)) expect_identical_(expr(1 + !!2 * 3 + 4), quote(1 + 2 * 3 + 4)) expect_identical_(expr(1 * !!2:!!3 + 4), quote(1 * 2:3 + 4)) expect_identical_(expr(1 + 2 + !!3 * 4 + 5 + 6), quote(1 + 2 + 3 * 4 + 5 + 6)) expect_identical_(expr(1 + 2 * 3 : !!4 + 5 * 6 + 7), quote(1 + 2 * 3 : 4 + 5 * 6 + 7)) expect_identical_(expr(1 + 2 * 3 : !!4 + 5 * 6 + 7 * 8 : !!9 + 10 * 11), quote(1 + 2 * 3 : 4 + 5 * 6 + 7 * 8 : 9 + 10 * 11)) expect_identical_(expr(!!1 + !!2 * !!3:!!4 + !!5 * !!6 + !!7 * !!8:!!9 + !!10 * !!11), quote(1 + 2 * 3 : 4 + 5 * 6 + 7 * 8 : 9 + 10 * 11)) expect_identical_(expr(!!1 + !!2 + !!3 + !!4), quote(1 + 2 + 3 + 4)) expect_identical_(expr(!!1 + !!2 * !!3), quote(1 + 2 * 3)) # Local roots expect_identical_(expr(!!1 + !!2 * !!3 * !!4), quote(1 + 2 * 3 * 4)) expect_identical_(expr(1 == 2 + !!3 + 4), quote(1 == 2 + 3 + 4)) expect_identical_(expr(!!1 == !!2 + !!3 + !!4 + !!5 * !!6 * !!7), quote(1 == 2 + 3 + 4 + 5 * 6 * 7)) expect_identical_(expr(1 + 2 * 3:!!4:5), quote(1 + 2 * 3:4:5)) expect_identical_(expr(!!1 == !!2), quote(1 == 2)) expect_identical_(expr(!!1 <= !!2), quote(1 <= 2)) expect_identical_(expr(!!1 >= !!2), quote(1 >= 2)) expect_identical_(expr(!!1 * 2 != 3), quote(1 * 2 != 3)) expect_identical_(expr(!!1 * !!2 / !!3 > !!4), quote(1 * 2 / 3 > 4)) expect_identical_(expr(!!1 * !!2 > !!3 + !!4), quote(1 * 2 > 3 + 4)) expect_identical_(expr(1 <= !!2), quote(1 <= 2)) expect_identical_(expr(1 >= !!2 : 3), quote(1 >= 2 : 3)) expect_identical_(expr(1 > !!2 * 3 : 4), quote(1 > 2 * 3 : 4)) expect_identical_(expr(!!1^2^3), quote(1)) expect_identical_(expr(!!1^2^3 + 4), quote(1 + 4)) expect_identical_(expr(!!1^2 + 3:4), quote(1 + 3:4)) }) test_that("`!!` handles binary and unary `-` and `+`", { expect_identical_(expr(!!1 + 2), quote(1 + 2)) expect_identical_(expr(!!1 - 2), quote(1 - 2)) expect_identical_(expr(!!+1 + 2), quote(1 + 2)) expect_identical_(expr(!!-1 - 2), expr(`!!`(-1) - 2)) expect_identical_(expr(1 + -!!3 + 4), quote(1 + -3 + 4)) expect_identical_(expr(1 + ---+!!3 + 4), quote(1 + ---+3 + 4)) expect_identical_(expr(+1), quote(+1)) expect_identical_(expr(+-!!1), quote(+-1)) expect_identical_(expr(+-!!(1 + 1)), quote(+-2)) expect_identical_(expr(+-!!+-1), bquote(+-.(-1))) expect_identical_(expr(+-+-!!+1), quote(+-+-1)) expect_identical_(expr(+-+-!!-1), bquote(+-+-.(-1))) expect_identical_(expr(+-+-!!1 - 2), quote(+-+-1 - 2)) expect_identical_(expr(+-+-!!+-+1 + 2), bquote(+-+-.(-1) + 2)) expect_identical(expr(+-+-!!+-!1 + 2), quote(+-+-0L)) expect_identical_(expr(+-+-!!+-identity(1)), bquote(+-+-.(-1))) expect_identical_(expr(+-+-!!+-identity(1) + 2), bquote(+-+-.(-1) + 2)) }) test_that("`!!` handles special operators", { expect_identical(expr(!! 1 %>% 2), quote(1 %>% 2)) }) test_that("LHS of nested `!!` is expanded (#405)", { expect_identical_(expr(!!1 + foo(!!2) + !!3), quote(1 + foo(2) + 3)) expect_identical_(expr(!!1 + !!2 + foo(!!3) + !!4), quote(1 + 2 + foo(3) + 4)) }) test_that("evaluates contents of `!!`", { expect_identical(expr(!!(1 + 2)), 3) }) test_that("quosures are not rewrapped", { var <- quo(!! quo(letters)) expect_identical(quo(!!var), quo(letters)) var <- new_quosure(local(~letters), env = child_env(get_env())) expect_identical(quo(!!var), var) }) test_that("UQ() fails if called without argument", { with_non_verbose_retirement({ quo <- quo(UQ(NULL)) expect_equal(quo, ~NULL) quo <- quo(rlang::UQ(NULL)) expect_equal(quo, ~NULL) quo <- tryCatch(quo(UQ()), error = identity) expect_is(quo, "error") expect_match(quo$message, "must be called with an argument") quo <- tryCatch(quo(rlang::UQ()), error = identity) expect_is(quo, "error") expect_match(quo$message, "must be called with an argument") }) }) # !!! --------------------------------------------------------------------- test_that("`!!!` treats atomic objects as scalar vectors", { expect_identical(quo(list(!!! get_env())), quo(list(!! get_env()))) expect_identical(expr(c(!!! expression(1, 2))), expr(c(!! expression(1, 2)))) }) test_that("values of `!!!` spliced into expression", { f <- quo(f(a, !!! list(quote(b), quote(c)), d)) expect_identical(f, quo(f(a, b, c, d))) }) test_that("names within `!!!` are preseved", { f <- quo(f(!!! list(a = quote(b)))) expect_identical(f, quo(f(a = b))) }) test_that("`!!!` handles `{` calls", { expect_identical(quo(list(!!! quote({ foo }))), quo(list(foo))) }) test_that("splicing an empty vector works", { expect_identical(expr_interp(~list(!!! list())), ~list()) expect_identical(expr_interp(~list(!!! character(0))), ~list()) expect_identical(expr_interp(~list(!!! NULL)), ~list()) }) # This fails but doesn't seem needed if (FALSE) { test_that("serialised unicode in argument names is unserialised on splice", { skip("failing") nms <- with_latin1_locale({ exprs <- exprs("\u5e78" := 10) quos <- quos(!!! exprs) names(quos) }) expect_identical(as_bytes(nms), as_bytes("\u5e78")) expect_true(all(chr_encoding(nms) == "UTF-8")) }) } test_that("can't splice at top level", { expect_error_(expr(!!! letters), "top level") }) test_that("can splice function body even if not a `{` block", { fn <- function(x) { x } expect_identical(exprs(!!! body(fn)), named_list(quote(x))) fn <- function(x) x expect_identical(exprs(!!! body(fn)), named_list(quote(x))) }) test_that("splicing a pairlist has no side effect", { x <- pairlist(NULL) expr(foo(!!! x, y)) expect_identical(x, pairlist(NULL)) }) test_that("`!!!` works in prefix form", { expect_identical(exprs(`!!!`(1:2)), named_list(1L, 2L)) expect_identical(expr(list(`!!!`(1:2))), quote(list(1L, 2L))) expect_identical(quos(`!!!`(1:2)), quos_list(quo(1L), quo(2L))) expect_identical(quo(list(`!!!`(1:2))), new_quosure(quote(list(1L, 2L)))) }) test_that("can't use prefix form of `!!!` with qualifying operators", { expect_error_(expr(foo$`!!!`(bar)), "Prefix form of `!!!` can't be used with `\\$`") expect_error_(expr(foo@`!!!`(bar)), "Prefix form of `!!!` can't be used with `@`") expect_error_(expr(foo::`!!!`(bar)), "Prefix form of `!!!` can't be used with `::`") expect_error_(expr(foo:::`!!!`(bar)), "Prefix form of `!!!` can't be used with `:::`") expect_error_(expr(rlang::`!!!`(bar)), "Prefix form of `!!!` can't be used with `::`") expect_error_(expr(rlang:::`!!!`(bar)), "Prefix form of `!!!` can't be used with `:::`") }) test_that("can't supply multiple arguments to `!!!`", { expect_error_(expr(list(`!!!`(1, 2))), "Can't supply multiple arguments to `!!!`") expect_error_(exprs(`!!!`(1, 2)), "Can't supply multiple arguments to `!!!`") }) test_that("`!!!` doesn't modify spliced inputs by reference", { x <- 1:3 quos(!!! x) expect_identical(x, 1:3) x <- as.list(1:3) quos(!!! x) expect_identical(x, as.list(1:3)) x <- quote({ 1L; 2L; 3L }) quos(!!! x) expect_equal(x, quote({ 1L; 2L; 3L })) # equal because of srcrefs }) # UQE ---------------------------------------------------------------- test_that("UQE() extracts right-hand side", { var <- ~cyl expect_warning_(expect_identical_(quo(mtcars$UQE(var)), quo(mtcars$cyl)), "deprecated") }) test_that("UQE() throws a deprecation warning", { expect_warning_(exprs(UQE("foo")), "deprecated") expect_warning_(quos(UQE("foo")), "deprecated") expect_warning_(expr(UQE("foo")), "deprecated") expect_warning_(quo(UQE("foo")), "deprecated") }) test_that("UQE() can't be used in by-value dots", { expect_error_(dots_list(UQE("foo")), "non-quoting function") }) # bang --------------------------------------------------------------- test_that("single ! is not treated as shortcut", { expect_identical(quo(!foo), as_quosure(~!foo)) }) test_that("double and triple ! are treated as syntactic shortcuts", { var <- local(quo(foo)) expect_identical(quo(!! var), as_quosure(var)) expect_identical(quo(!! quo(foo)), quo(foo)) expect_identical(quo(list(!!! letters[1:3])), quo(list("a", "b", "c"))) }) test_that("`!!` works in prefixed calls", { var <- quo(cyl) expect_identical(expr_interp(~mtcars$`!!`(quo_expr(var))), ~mtcars$cyl) expect_identical(expr_interp(~foo$`!!`(quote(bar))), ~foo$bar) expect_identical(expr_interp(~base::`!!`(quote(list))()), ~base::list()) }) test_that("one layer of parentheses around !! is removed", { foo <- "foo" expect_identical(expr((!! foo)), "foo") expect_identical(expr(((!! foo))), quote(("foo"))) expect_identical(expr((!! foo) + 1), quote("foo" + 1)) expect_identical(expr(((!! foo)) + 1), quote(("foo") + 1)) expect_identical(expr((!! sym(foo))(bar)), quote(foo(bar))) expect_identical(expr(((!! sym(foo)))(bar)), quote((foo)(bar))) expect_identical(exprs((!! foo), ((!! foo))), named_list("foo", quote(("foo")))) }) test_that("parentheses are not removed if there's a tail", { expect_identical(expr((!! "a" + b)), quote(("a" + b))) }) test_that("can use prefix form of `!!` with qualifying operators", { expect_identical(expr(foo$`!!`(quote(bar))), quote(foo$bar)) expect_identical(expr(foo@`!!`(quote(bar))), quote(foo@bar)) expect_identical(expr(foo::`!!`(quote(bar))), quote(foo::bar)) expect_identical(expr(foo:::`!!`(quote(bar))), quote(foo:::bar)) expect_identical(expr(rlang::`!!`(quote(bar))), quote(rlang::bar)) expect_identical(expr(rlang:::`!!`(quote(bar))), quote(rlang:::bar)) }) # quosures ----------------------------------------------------------- test_that("quosures are created for all informative formulas", { foo <- local(quo(foo)) bar <- local(quo(bar)) interpolated <- local(quo(list(!!foo, !!bar))) expected <- new_quosure(call2("list", as_quosure(foo), as_quosure(bar)), env = get_env(interpolated)) expect_identical(interpolated, expected) interpolated <- quo(!!interpolated) expect_identical(interpolated, expected) }) # dots_values() ------------------------------------------------------ test_that("can unquote-splice symbols", { spliced <- list2(!!! list(quote(`_symbol`))) expect_identical(spliced, list(quote(`_symbol`))) }) test_that("can unquote symbols", { expect_error_(dots_values(!! quote(.)), "`!!` in a non-quoting function") with_non_verbose_retirement( expect_error_(dots_values(rlang::UQ(quote(.))), "`!!` in a non-quoting function") ) }) # := ----------------------------------------------------------------- test_that("`:=` unquotes its LHS as name unless `.unquote_names` is FALSE", { expect_identical(exprs(a := b), list(a = quote(b))) expect_identical(exprs(a := b, .unquote_names = FALSE), named_list(quote(a := b))) expect_identical(quos(a := b), quos_list(a = quo(b))) expect_identical(quos(a := b, .unquote_names = FALSE), quos_list(new_quosure(quote(a := b)))) expect_identical(dots_list(a := NULL), list(a = NULL)) expect_identical(dots_splice(a := NULL), list(a = NULL)) }) test_that("`:=` chaining is detected at dots capture", { expect_error(exprs(a := b := c), "chained") expect_error(quos(a := b := c), "chained") expect_error(dots_list(a := b := c), "chained") expect_error(dots_splice(a := b := c), "chained") }) # -------------------------------------------------------------------- test_that("Unquote operators fail when called outside quasiquoted arguments", { expect_qq_error <- function(object) expect_error(object, regexp = "within a quasiquoted argument") expect_qq_error(UQ()) expect_warning_(expect_qq_error(UQE()), "deprecated") expect_qq_error(UQS()) expect_qq_error(`!!`()) expect_qq_error(`!!!`()) expect_qq_error(a := b) }) # Lifecycle ---------------------------------------------------------- test_that("namespaced unquoting is soft-deprecated", { with_non_verbose_retirement({ expect_no_warning_(exprs(rlang::UQS(1:2))) expect_no_warning_(quo(list(rlang::UQ(1:2)))) }) with_verbose_retirement({ expect_warning_(exprs(rlang::UQS(1:2)), "`UQS()` with a namespace is soft-deprecated", fixed = TRUE) expect_warning_(quo(list(rlang::UQ(1:2))), "`UQ()` with a namespace is soft-deprecated", fixed = TRUE) }) }) rlang/tests/testthat/test-node.R0000644000176200001440000000463513241233650016413 0ustar liggesuserscontext("node") test_that("node() creates a pairlist node", { x <- new_node("foo", "bar") expect_is(x, "pairlist") expect_identical(node_car(x), "foo") expect_identical(node_cdr(x), "bar") }) test_that("node getters and pokers work", { A <- as.pairlist(c(a = "a", b = "b")) B <- as.pairlist(c(A = "A", B = "B")) x <- pairlist(foo = A, bar = B, baz = "baz") expect_identical(node_car(x), A) expect_identical(node_cdr(x), pairlist(bar = B, baz = "baz")) expect_identical(node_caar(x), "a") expect_identical(node_cadr(x), B) expect_identical(node_cdar(x), pairlist(b = "b")) expect_identical(node_cddr(x), pairlist(baz = "baz")) expect_identical(node_tag(x), sym("foo")) node_poke_car(x, B) expect_identical(node_car(x), B) node_poke_cdr(x, pairlist(foo = A)) expect_identical(node_cdr(x), pairlist(foo = A)) node_poke_cdar(x, "cdar") expect_identical(node_cdar(x), "cdar") node_poke_caar(x, "caar") expect_identical(node_caar(x), "caar") node_poke_cadr(x, "cadr") expect_identical(node_cadr(x), "cadr") node_poke_cddr(x, "cddr") expect_identical(node_cddr(x), "cddr") node_poke_tag(x, sym("tag")) expect_identical(node_tag(x), sym("tag")) }) test_that("node_tree_clone() clones all nodes", { x <- pairlist(1, pairlist(2)) clone <- node_tree_clone(x) # Outer vector expect_false(sxp_address(x) == sxp_address(clone)) # Outer node list expect_true(sxp_address(node_car(x)) == sxp_address(node_car(clone))) cdr <- node_cdr(x) clone_cdr <- node_cdr(clone) expect_false(sxp_address(cdr) == sxp_address(clone_cdr)) # Inner node list cadr <- node_car(cdr) clone_cadr <- node_car(clone_cdr) expect_false(sxp_address(cadr) == sxp_address(clone_cadr)) # Inner vector caadr <- node_car(cadr) clone_caadr <- node_car(clone_cadr) expect_true(sxp_address(caadr) == sxp_address(clone_caadr)) }) test_that("as_pairlist() converts to pairlist", { expect_identical(as_pairlist(letters), as.pairlist(letters)) expect_error(as_pairlist(quote(foo)), "Can't convert a symbol to a pairlist node") expect_identical(as_pairlist(NULL), NULL) x <- pairlist(1, 2) expect_identical(as_pairlist(x), x) }) test_that("pairlist predicates detect pairlists", { node <- new_node(NULL) call <- quote(foo(bar)) expect_true(is_pairlist(node)) expect_true(is_node(node)) expect_true(is_node(call)) expect_true(is_node_list(node)) expect_true(is_node_list(NULL)) }) rlang/tests/testthat/test-deparse.R0000644000176200001440000003116213241233650017104 0ustar liggesuserscontext("deparse") test_that("line_push() adds indentation", { out <- line_push("foo", "bar", width = 4, indent = 2) expect_identical(out, c("foo", " bar")) }) test_that("line_push() doesn't make a new line if current is only spaces", { expect_identical(line_push(" ", "foo", width = 2L), " foo") }) test_that("line_push() trims trailing spaces", { expect_identical(line_push("foo ", "bar", width = 1L), c("foo", "bar")) }) test_that("line_push() doesn't trim trailing spaces on sticky inputs", { expect_identical(line_push("tag", " = ", sticky = TRUE, width = 3L, indent = 2L), "tag = ") }) test_that("sticky input sticks", { expect_identical(line_push("foo ", "bar", sticky = TRUE, width = 1L), "foo bar") }) test_that("line_push() respects boundaries", { expect_identical(line_push("foo, ", "bar", boundary = 4L, width = 1L, indent = 2L), c("foo,", " bar")) expect_identical(line_push("foo, ", "bar", sticky = TRUE, boundary = 4L, width = 1L, indent = 2L), c("foo,", " bar")) expect_identical(line_push("foo, bar", "baz", boundary = 4L, width = 1L, indent = 2L), c("foo, bar", " baz")) }) test_that("line_push() handles the nchar(line) == boundary case", { expect_identical(line_push(" tag = ", "bar", sticky = TRUE, boundary = 8L, width = 3L, indent = 2L), " tag = bar") }) test_that("line_push() strips ANSI codes before computing overflow", { if (!has_crayon()) { skip("test needs crayon") } expect_identical(length(line_push("foo", open_blue(), width = 3L)), 2L) expect_identical(length(line_push("foo", open_blue(), width = 3L, has_colour = TRUE)), 1L) }) test_that("can push several lines (useful for default base deparser)", { expect_identical(new_lines()$push(c("foo", "bar"))$get_lines(), "foobar") }) test_that("control flow is deparsed", { expect_identical(fn_call_deparse(expr(function(a, b) 1)), "function(a, b) 1") expect_identical(fn_call_deparse(expr(function(a = 1, b = 2) { 3; 4; 5 })), c("function(a = 1, b = 2) {", " 3", " 4", " 5", "}")) expect_identical(while_deparse(quote(while(1) 2)), "while (1) 2") expect_identical(for_deparse(quote(for(a in 2) 3)), "for (a in 2) 3") expect_identical(repeat_deparse(quote(repeat 1)), "repeat 1") expect_identical(if_deparse(quote(if (1) 2 else { 3 })), c("if (1) 2 else {", " 3", "}")) }) test_that("functions defs increase indent", { ctxt <- new_lines(width = 3L) expect_identical(sexp_deparse(quote(function() 1), ctxt), c("function()", " 1")) ctxt <- new_lines(width = 3L) expect_identical(sexp_deparse(function() 1, ctxt), c("")) }) test_that("blocks are deparsed", { expect_identical(braces_deparse(quote({1; 2; { 3; 4 }})), c("{", " 1", " 2", " {", " 3", " 4", " }", "}")) expect_identical(sexp_deparse(quote({{ 1 }})), c("{", " {", " 1", " }", "}")) ctxt <- new_lines(width = 3L) expected_lines <- c("{", " 11111", " 22222", " {", " 33333", " 44444", " }", "}") expect_identical(braces_deparse(quote({11111; 22222; { 33333; 44444 }}), ctxt), expected_lines) }) test_that("multiple openers on the same line only trigger one indent", { ctxt <- new_lines(width = 3L) expect_identical(sexp_deparse(quote(function() { 1 }), ctxt), c("function()", " {", " 1", " }")) ctxt <- new_lines(width = 12L) expect_identical(sexp_deparse(quote(function() { 1 }), ctxt), c("function() {", " 1", "}")) }) test_that("multiple openers on the same line are correctly reset", { expect_identical(sexp_deparse(quote({ 1(2()) })), c("{", " 1(2())", "}")) }) test_that("parentheses are deparsed", { expect_identical(parens_deparse(quote((1))), "(1)") expect_identical(parens_deparse(quote(({ 1; 2 }))), c("({", " 1", " 2", "})")) expect_identical(sexp_deparse(quote(({({ 1 })}))), c("({", " ({", " 1", " })", "})")) }) test_that("spaced operators are deparsed", { expect_identical(spaced_op_deparse(quote(1 ? 2)), "1 ? 2") expect_identical(spaced_op_deparse(quote(1 <- 2)), "1 <- 2") expect_identical(spaced_op_deparse(quote(1 <<- 2)), "1 <<- 2") expect_identical(spaced_op_deparse(quote(`=`(1, 2))), "1 = 2") expect_identical(spaced_op_deparse(quote(1 := 2)), "1 := 2") expect_identical(spaced_op_deparse(quote(1 ~ 2)), "1 ~ 2") expect_identical(spaced_op_deparse(quote(1 | 2)), "1 | 2") expect_identical(spaced_op_deparse(quote(1 || 2)), "1 || 2") expect_identical(spaced_op_deparse(quote(1 & 2)), "1 & 2") expect_identical(spaced_op_deparse(quote(1 && 2)), "1 && 2") expect_identical(spaced_op_deparse(quote(1 > 2)), "1 > 2") expect_identical(spaced_op_deparse(quote(1 >= 2)), "1 >= 2") expect_identical(spaced_op_deparse(quote(1 < 2)), "1 < 2") expect_identical(spaced_op_deparse(quote(1 <= 2)), "1 <= 2") expect_identical(spaced_op_deparse(quote(1 == 2)), "1 == 2") expect_identical(spaced_op_deparse(quote(1 != 2)), "1 != 2") expect_identical(spaced_op_deparse(quote(1 + 2)), "1 + 2") expect_identical(spaced_op_deparse(quote(1 - 2)), "1 - 2") expect_identical(spaced_op_deparse(quote(1 * 2)), "1 * 2") expect_identical(spaced_op_deparse(quote(1 / 2)), "1 / 2") expect_identical(spaced_op_deparse(quote(1 %% 2)), "1 %% 2") expect_identical(spaced_op_deparse(quote(1 %>% 2)), "1 %>% 2") expect_identical(sexp_deparse(quote({ 1; 2 } + { 3; 4 })), c("{", " 1", " 2", "} + {", " 3", " 4", "}")) }) test_that("unspaced operators are deparsed", { expect_identical(unspaced_op_deparse(quote(1:2)), "1:2") expect_identical(unspaced_op_deparse(quote(1^2)), "1^2") expect_identical(unspaced_op_deparse(quote(a$b)), "a$b") expect_identical(unspaced_op_deparse(quote(a@b)), "a@b") expect_identical(unspaced_op_deparse(quote(a::b)), "a::b") expect_identical(unspaced_op_deparse(quote(a:::b)), "a:::b") }) test_that("operands are wrapped in parentheses to ensure correct predecence", { expect_identical_(sexp_deparse(expr(1 + !!quote(2 + 3))), "1 + (2 + 3)") expect_identical_(sexp_deparse(expr((!!quote(1^2))^3)), "(1^2)^3") expect_identical_(sexp_deparse(quote(function() 1 ? 2)), "function() 1 ? 2") expect_identical_(sexp_deparse(expr(!!quote(function() 1) ? 2)), "(function() 1) ? 2") }) test_that("unary operators are deparsed", { expect_identical(unary_op_deparse(quote(?1)), "?1") expect_identical(unary_op_deparse(quote(~1)), "~1") expect_identical(unary_op_deparse(quote(!1)), "!1") expect_identical_(unary_op_deparse(quote(!!1)), "!!1") expect_identical_(unary_op_deparse(quote(!!!1)), "!!!1") expect_identical_(unary_op_deparse(quote(`!!`(1))), "!!1") expect_identical_(unary_op_deparse(quote(`!!!`(1))), "!!!1") expect_identical(unary_op_deparse(quote(+1)), "+1") expect_identical(unary_op_deparse(quote(-1)), "-1") }) test_that("brackets are deparsed", { expect_identical(sexp_deparse(quote(1[2])), c("1[2]")) expect_identical(sexp_deparse(quote(1[[2]])), c("1[[2]]")) ctxt <- new_lines(width = 1L) expect_identical(sexp_deparse(quote(1[2]), ctxt), c("1[", " 2]")) ctxt <- new_lines(width = 1L) expect_identical(sexp_deparse(quote(1[[2]]), ctxt), c("1[[", " 2]]")) }) test_that("calls are deparsed", { expect_identical(call_deparse(quote(foo(bar, baz))), "foo(bar, baz)") expect_identical(call_deparse(quote(foo(one = bar, two = baz))), "foo(one = bar, two = baz)") }) test_that("call_deparse() respects boundaries", { ctxt <- new_lines(width = 1L) expect_identical(call_deparse(quote(foo(bar, baz)), ctxt), c("foo(", " bar,", " baz)")) ctxt <- new_lines(width = 7L) expect_identical(call_deparse(quote(foo(bar, baz)), ctxt), c("foo(", " bar,", " baz)")) ctxt <- new_lines(width = 8L) expect_identical(call_deparse(quote(foo(bar, baz)), ctxt), c("foo(bar,", " baz)")) ctxt <- new_lines(width = 1L) expect_identical(call_deparse(quote(foo(one = bar, two = baz)), ctxt), c("foo(", " one = bar,", " two = baz)")) }) test_that("call_deparse() handles multi-line arguments", { ctxt <- new_lines(width = 1L) expect_identical(sexp_deparse(quote(foo(one = 1, two = nested(one = 1, two = 2))), ctxt), c("foo(", " one = 1,", " two = nested(", " one = 1,", " two = 2))")) ctxt <- new_lines(width = 20L) expect_identical(sexp_deparse(quote(foo(one = 1, two = nested(one = 1, two = 2))), ctxt), c("foo(one = 1, two = nested(", " one = 1, two = 2))")) }) test_that("literal functions are deparsed", { expect_identical_(sexp_deparse(function(a) 1), "") expect_identical_(sexp_deparse(expr(foo(!!function(a) 1))), "foo()") }) test_that("literal dots are deparsed", { dots <- (function(...) env_get(, "..."))(NULL) expect_identical_(sexp_deparse(expr(foo(!!dots))), "foo(<...>)") }) test_that("environments are deparsed", { expect_identical(sexp_deparse(expr(foo(!! env()))), "foo()") }) test_that("atomic vectors are deparsed", { expect_identical(sexp_deparse(set_names(c(TRUE, FALSE, TRUE), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(1:3, c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(c(1, 2, 3), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(as.complex(1:3), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(as.character(1:3), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(as.raw(1:3), c("", "b", ""))), "") }) test_that("boundaries are respected when deparsing vectors", { ctxt <- new_lines(width = 1L) vec <- set_names(1:3, c("", "b", "")) expect_identical_(sexp_deparse(expr(foo(!!vec)), ctxt), c("foo(", " )")) ctxt <- new_lines(width = 12L) expect_identical(sexp_deparse(list(c("foo", "bar", "baz")), ctxt), c(">")) }) test_that("scalar atomic vectors are simply printed", { expect_identical(sexp_deparse(TRUE), "TRUE") expect_identical(sexp_deparse(1L), "1L") expect_identical(sexp_deparse(1), "1") expect_identical(sexp_deparse(1i), "0+1i") expect_identical(sexp_deparse("1"), "\"1\"") }) test_that("scalar raw vectors are printed in long form", { expect_identical(sexp_deparse(as.raw(1)), "") }) test_that("literal lists are deparsed", { expect_identical(sexp_deparse(list(TRUE, b = 2L, 3, d = "4", as.raw(5))), ">") }) test_that("long vectors are truncated", { expect_identical(sexp_deparse(1:10), "") expect_identical(sexp_deparse(as.list(1:10)), "") }) test_that("other objects are deparsed with base deparser", { expect_identical_(sexp_deparse(expr(foo((!!base::list)(1, 2)))), "foo(.Primitive(\"list\")(1, 2))") expect_identical_(sexp_deparse(expr(foo((!!base::`if`)(1, 2)))), "foo(.Primitive(\"if\")(1, 2))") }) test_that("S3 objects are deparsed", { expr <- expr(list(!!factor(1:3), !!structure(list(), class = c("foo", "bar", "baz")))) expect_identical(sexp_deparse(expr), "list(, )") }) test_that("successive indentations on a single line are only counted once", { ctxt <- new_lines(5L) broken_output <- c(">") expect_identical(sexp_deparse(list(c(foo = "bar", baz = "bam")), ctxt), broken_output) ctxt <- new_lines(12L) unbroken_output <- c(">") expect_identical(sexp_deparse(list(c(foo = "bar", baz = "bam")), ctxt), unbroken_output) }) test_that("successive indentations close off properly", { expect_identical(sexp_deparse(quote(1(2(), 3(4())))), "1(2(), 3(4()))") expect_identical(sexp_deparse(quote(1(2(), 3(4()))), new_lines(width = 1L)), c("1(", " 2(),", " 3(", " 4()))")) expect_identical(sexp_deparse(expr(c((1), function() { 2 }))), c("c((1), function() {", " 2", "})")) }) test_that("empty quosures are deparsed", { expect_identical(strip_style(quo_deparse(quo())), "^") }) test_that("missing values are deparsed", { expect_identical(sexp_deparse(NA), "NA") expect_identical(sexp_deparse(c(name = NA)), "") expect_identical(sexp_deparse(NA_integer_), "") expect_identical(sexp_deparse(NA_real_), "") expect_identical(sexp_deparse(NA_complex_), "") expect_identical(sexp_deparse(NA_character_), "") expect_identical(sexp_deparse(c(NA, "NA")), "") expect_identical(sexp_deparse(quote(call(NA))), "call(NA)") expect_identical(sexp_deparse(quote(call(NA_integer_))), "call()") expect_identical(sexp_deparse(quote(call(NA_real_))), "call()") expect_identical(sexp_deparse(quote(call(NA_complex_))), "call()") expect_identical(sexp_deparse(quote(call(NA_character_))), "call()") }) rlang/tests/testthat/helper-stack.R0000644000176200001440000000071313241233650017064 0ustar liggesusers fixup_calls <- function(x) { cur_pos <- sys.nframe() - 1 x[seq(n+1, length(x))] } fixup_ctxt_depth <- function(x) { x - (sys.nframe() - 1) } fixup_call_depth <- function(x) { x - (call_depth() - 1) } fixup_call_trail <- function(trail) { eval_callers <- ctxt_stack_callers() cur_trail <- trail_make(eval_callers) cur_pos <- eval_callers[1] indices <- seq(1, length(trail) - length(cur_trail)) trail <- trail[indices] trail - cur_pos } rlang/tests/testthat/test-quo.R0000644000176200001440000001277713241233650016300 0ustar liggesuserscontext("quo") test_that("quo_get_expr() and quo_get_env() retrieve quosure components", { quo <- quo(foo) expect_identical(quo_get_expr(quo), quote(foo)) expect_identical(quo_get_env(quo), environment()) }) test_that("quo_set_expr() and quo_set_env() set quosure components", { orig <- quo() env <- env() quo <- quo_set_expr(orig, quote(foo)) expect_identical(quo_get_expr(quo), quote(foo)) expect_identical(quo_get_expr(orig), missing_arg()) quo <- quo_set_env(orig, env) expect_identical(quo_get_env(quo), env) expect_identical(quo_get_env(orig), empty_env()) }) test_that("quosure getters and setters check inputs", { expect_error(quo_get_expr(10L), "`quo` must be a quosure") expect_error(quo_set_expr(10L, NULL), "`quo` must be a quosure") expect_error(quo_get_env(10L), "`quo` must be a quosure") expect_error(quo_set_env(10L, env()), "`quo` must be a quosure") expect_error(quo_set_env(quo(), 10L), "`env` must be an environment") }) test_that("generic getters work on quosures", { expect_identical(get_expr(quo(foo)), quote(foo)) expect_identical(get_env(quo(foo)), environment()) }) test_that("generic setters work on quosures", { orig <- quo() env <- env() quo <- set_env(set_expr(orig, quote(foo)), env) expect_identical(quo_get_expr(quo), quote(foo)) expect_identical(quo_get_env(quo), env) }) test_that("can flatten empty quosure", { expect_identical(quo_expr(quo()), missing_arg()) }) test_that("new_quosure() checks inputs", { expect_error(new_quosure(quote(a), env = list()), "must be an environment") }) test_that("new_quosure() produces expected internal structure", { quo <- new_quosure(quote(abc)) expect_identical(set_attrs(~abc, class = c("quosure", "formula")), quo) }) test_that("new_quosure() double wraps", { quo1 <- quo(foo) quo2 <- new_quosure(quo1) expect_identical(quo_get_expr(quo2), quo1) }) test_that("as_quosure() uses correct env", { fn <- function(expr, env = caller_env()) { f <- as_quosure(expr, env) list(env = get_env(), quo = g(f)) } g <- function(expr, env = caller_env()) { as_quosure(expr, env) } quo_env <- child_env(NULL) quo <- new_quosure(quote(expr), quo_env) out_expr_default <- fn(quote(expr)) out_quo_default <- fn(quo) expect_identical(quo_get_env(out_expr_default$quo), get_env()) expect_identical(quo_get_env(out_quo_default$quo), quo_env) user_env <- child_env(NULL) out_expr <- fn(quote(expr), user_env) out_quo <- fn(quo, user_env) expect_identical(quo_get_env(out_expr$quo), user_env) expect_identical(out_quo$quo, quo) }) test_that("explicit promise makes a formula", { capture <- function(x) enquo(x) f1 <- capture(1 + 2 + 3) f2 <- ~ 1 + 2 + 3 expect_equal(f1, f2) }) test_that("explicit promise works only one level deep", { f <- function(x) list(env = get_env(), f = g(x)) g <- function(y) enquo(y) out <- f(1 + 2 + 3) expected_f <- with_env(out$env, quo(x)) expect_identical(out$f, expected_f) }) test_that("can capture optimised constants", { arg <- function() { quo("foobar") } arg_bytecode <- compiler::cmpfun(arg) expect_identical(arg(), quo("foobar")) expect_identical(arg_bytecode(), quo("foobar")) dots <- function() { quos("foo", "bar") } dots_bytecode <- compiler::cmpfun(dots) expect_identical(dots(), quos("foo", "bar")) expect_identical(dots_bytecode(), quos("foo", "bar")) }) test_that("quosures are spliced", { q <- quo(foo(!! quo(bar), !! quo(baz(!! quo(baz), 3)))) expect_identical(quo_text(q), "foo(bar, baz(baz, 3))") q <- expr_interp(~foo::bar(!! function(x) ...)) expect_identical(f_text(q), "foo::bar(function (x) \n...)") q <- quo(!! quo(!! quo(foo(!! quo(!! quo(bar(!! quo(!! quo(!! quo(baz)))))))))) expect_identical(quo_text(q), "foo(bar(baz))") }) test_that("formulas are not spliced", { expect_identical(quo_text(quo(~foo(~bar))), "~foo(~bar)") }) test_that("splicing does not affect original quosure", { f <- ~foo(~bar) quo_text(f) expect_identical(f, ~foo(~bar)) }) test_that("as_quosure() doesn't convert functions", { expect_identical(as_quosure(base::mean), set_env(quo(!! base::mean), empty_env())) }) test_that("as_quosure() coerces formulas", { expect_identical(as_quosure(~foo), quo(foo)) }) test_that("quo_expr() warns", { expect_warning(regex = NA, quo_expr(quo(foo), warn = TRUE)) expect_warning(quo_expr(quo(list(!! quo(foo))), warn = TRUE), "inner quosure") }) test_that("quo_deparse() indicates quosures with `^`", { x <- quo(list(!! quo(NULL), !! quo(foo()))) ctxt <- new_quo_deparser(crayon = FALSE) expect_identical(quo_deparse(x, ctxt), "^list(^NULL, ^foo())") }) test_that("quosure deparser respects width", { x <- quo(foo(quo(!!quo(bar)))) expect_identical(length(quo_deparse(x, new_quo_deparser(width = 8L))), 3L) expect_identical(length(quo_deparse(x, new_quo_deparser(width = 9L))), 2L) }) test_that("quosure predicates work", { expect_true(quo_is_missing(quo())) expect_true(quo_is_symbol(quo(sym), "sym")) expect_false(quo_is_symbol(quo(sym), "foo")) expect_true(quo_is_call(quo(call()))) expect_true(quo_is_call(quo(ns::call()), "call", 0L, "ns")) expect_false(quo_is_call(quo(ns::call()), "call", 1L, "ns")) expect_true(quo_is_symbolic(quo(sym))) expect_true(quo_is_symbolic(quo(call()))) expect_true(quo_is_null(quo(NULL))) expect_false(quo_is_missing(quo(10L))) expect_false(quo_is_symbol(quo(10L))) expect_false(quo_is_call(quo(10L))) expect_false(quo_is_symbolic(quo(10L))) expect_false(quo_is_symbolic(quo(10L))) expect_false(quo_is_null(quo(10L))) }) rlang/tests/testthat/test-expr.R0000644000176200001440000000417113241233650016437 0ustar liggesuserscontext("expr") # expr_text() -------------------------------------------------------- test_that("always returns single string", { out <- expr_text(quote({ a + b })) expect_length(out, 1) }) test_that("can truncate lines", { out <- expr_text(quote({ a + b }), nlines = 2) expect_equal(out, "{\n...") }) # expr_label() ------------------------------------------------------- test_that("quotes strings", { expect_equal(expr_label("a"), '"a"') expect_equal(expr_label("\n"), '"\\n"') }) test_that("backquotes names", { expect_equal(expr_label(quote(x)), "`x`") }) test_that("converts atomics to strings", { expect_equal(expr_label(0.5), "0.5") }) test_that("expr_label() truncates blocks", { expect_identical(expr_label(quote({ a + b })), "`{ ... }`") expect_identical(expr_label(expr(function() { a; b })), "`function() ...`") }) test_that("expr_label() truncates long calls", { long_call <- quote(foo()) long_arg <- quote(longlonglonglonglonglonglonglonglonglonglonglong) long_call[c(2, 3, 4)] <- list(long_arg, long_arg, long_arg) expect_identical(expr_label(long_call), "`foo(...)`") }) # expr_name() -------------------------------------------------------- test_that("name symbols, calls, and scalars", { expect_identical(expr_name(quote(foo)), "foo") expect_identical(expr_name(quote(foo(bar))), "foo(bar)") expect_identical(expr_name(1L), "1") expect_identical(expr_name("foo"), "foo") expect_identical(expr_name(function() NULL), "function () ...") expect_error(expr_name(1:2), "must quote a symbol, scalar, or call") expect_identical(expr_name(expr(function() { a; b })), "function() ...") }) # -------------------------------------------------------------------- test_that("get_expr() supports closures", { skip("Disabled because causes dplyr to fail") expect_identical(get_expr(identity), quote(x)) }) test_that("set_expr() supports closures", { fn <- function(x) x expect_equal(set_expr(fn, quote(y)), function(x) y) }) test_that("expressions are deparsed and printed", { expect_output(expr_print(1:2), "") expect_identical(expr_deparse(1:2), "") }) rlang/tests/testthat/test-vec-new.R0000644000176200001440000001402013241233650017017 0ustar liggesuserscontext("vec-new") test_that("atomic vectors are spliced", { lgl <- lgl(TRUE, c(TRUE, FALSE), list(FALSE, FALSE)) expect_identical(lgl, c(TRUE, TRUE, FALSE, FALSE, FALSE)) int <- int(1L, c(2L, 3L), list(4L, 5L)) expect_identical(int, 1:5) dbl <- dbl(1, c(2, 3), list(4, 5)) expect_identical(dbl, as_double(1:5)) cpl <- cpl(1i, c(2i, 3i), list(4i, 5i)) expect_identical(cpl, c(1i, 2i, 3i, 4i, 5i)) chr <- chr("foo", c("foo", "bar"), list("buz", "baz")) expect_identical(chr, c("foo", "foo", "bar", "buz", "baz")) raw <- bytes(1, c(2, 3), list(4, 5)) expect_identical(raw, bytes(1:5)) }) test_that("can create empty vectors", { expect_identical(lgl(), logical(0)) expect_identical(int(), integer(0)) expect_identical(dbl(), double(0)) expect_identical(cpl(), complex(0)) expect_identical(chr(), character(0)) expect_identical(bytes(), raw(0)) expect_identical(list2(), list()) }) test_that("objects are not spliced", { expect_error(lgl(structure(list(TRUE, TRUE), class = "bam")), "Can't splice S3 objects") }) test_that("explicitly spliced lists are spliced", { expect_identical(lgl(FALSE, structure(list(TRUE, TRUE), class = "spliced")), c(FALSE, TRUE, TRUE)) }) test_that("splicing uses inner names", { expect_identical(lgl(c(a = TRUE, b = FALSE)), c(a = TRUE, b = FALSE)) expect_identical(lgl(list(c(a = TRUE, b = FALSE))), c(a = TRUE, b = FALSE)) }) test_that("splicing uses outer names when scalar", { expect_identical(lgl(a = TRUE, b = FALSE), c(a = TRUE, b = FALSE)) expect_identical(lgl(list(a = TRUE, b = FALSE)), c(a = TRUE, b = FALSE)) }) test_that("warn when outer names unless input is unnamed scalar atomic", { expect_warning(expect_identical(dbl(a = c(1, 2)), c(1, 2)), "Outer names") expect_warning(expect_identical(dbl(list(a = c(1, 2))), c(1, 2)), "Outer names") expect_warning(expect_identical(dbl(a = c(A = 1)), c(A = 1)), "Outer names") expect_warning(expect_identical(dbl(list(a = c(A = 1))), c(A = 1)), "Outer names") }) test_that("warn when spliced lists have outer name", { expect_warning(lgl(list(c = c(cc = FALSE))), "Outer names") }) test_that("list2() doesn't splice bare lists", { expect_identical(list2(list(1, 2)), list(list(1, 2))) expect_identical(list2(!!! list(1, 2)), list(1, 2)) }) test_that("atomic inputs are implicitly coerced", { expect_identical(lgl(10L, FALSE, list(TRUE, 0L, 0)), c(TRUE, FALSE, TRUE, FALSE, FALSE)) expect_identical(dbl(10L, 10, TRUE, list(10L, 0, TRUE)), c(10, 10, 1, 10, 0, 1)) expect_error(lgl("foo"), "Can't convert a string to a logical vector") expect_error(chr(10), "Can't convert a double vector to a character vector") }) test_that("type errors are handled", { expect_error(lgl(env(a = 1)), "Internal error: expected a vector") expect_error(lgl(list(env())), "Internal error: expected a vector") }) test_that("empty inputs are spliced", { expect_identical(lgl(NULL, lgl(), list(NULL, lgl())), lgl()) expect_warning(regexp = NA, expect_identical(lgl(a = NULL, a = lgl(), list(a = NULL, a = lgl())), lgl())) }) test_that("list2() splices names", { expect_identical(list2(a = TRUE, b = FALSE), list(a = TRUE, b = FALSE)) expect_identical(list2(c(A = TRUE), c(B = FALSE)), list(c(A = TRUE), c(B = FALSE))) expect_identical(list2(a = c(A = TRUE), b = c(B = FALSE)), list(a = c(A = TRUE), b = c(B = FALSE))) }) test_that("ll() is an alias to list2()", { expect_identical(ll(!!! list(1, 2)), list(1, 2)) }) test_that("vector ctors take names arguments", { expect_identical(new_logical(2, letters[1:2]), c(a = NA, b = NA)) expect_identical(new_integer(2, letters[1:2]), c(a = na_int, b = na_int)) expect_identical(new_double(2, letters[1:2]), c(a = na_dbl, b = na_dbl)) expect_identical(new_complex(2, letters[1:2]), c(a = na_cpl, b = na_cpl)) expect_identical(new_character(2, letters[1:2]), c(a = na_chr, b = na_chr)) expect_identical(new_raw(2, letters[1:2]), set_names(raw(2), c("a", "b"))) expect_identical(new_list(2, letters[1:2]), list(a = NULL, b = NULL)) }) test_that("vector _along() ctors pick up names", { x <- list(a = NULL, b = NULL) expect_identical(new_logical_along(x), c(a = NA, b = NA)) expect_identical(new_integer_along(x), c(a = na_int, b = na_int)) expect_identical(new_double_along(x), c(a = na_dbl, b = na_dbl)) expect_identical(new_complex_along(x), c(a = na_cpl, b = na_cpl)) expect_identical(new_character_along(x), c(a = na_chr, b = na_chr)) expect_identical(new_raw_along(x), set_names(raw(2), c("a", "b"))) expect_identical(new_list_along(x), list(a = NULL, b = NULL)) }) test_that("vector _along() ctors pick up names", { x <- list(a = NULL, b = NULL) expect_identical(new_logical_along(x, toupper), c(A = NA, B = NA)) expect_identical(new_integer_along(x, toupper), c(A = na_int, B = na_int)) expect_identical(new_double_along(x, toupper), c(A = na_dbl, B = na_dbl)) expect_identical(new_complex_along(x, toupper), c(A = na_cpl, B = na_cpl)) expect_identical(new_character_along(x, toupper), c(A = na_chr, B = na_chr)) expect_identical(new_raw_along(x, toupper), set_names(raw(2), c("A", "B"))) expect_identical(new_list_along(x, toupper), list(A = NULL, B = NULL)) }) test_that("retired _len() ctors still work", { expect_identical(lgl_len(2), new_logical(2)) expect_identical(int_len(2), new_integer(2)) expect_identical(dbl_len(2), new_double(2)) expect_identical(chr_len(2), new_character(2)) expect_identical(cpl_len(2), new_complex(2)) expect_identical(raw_len(2), new_raw(2)) expect_identical(bytes_len(2), new_raw(2)) expect_identical(list_len(2), new_list(2)) }) test_that("retired _along() ctors still work", { expect_identical(lgl_along(1:2), new_logical_along(1:2)) expect_identical(int_along(1:2), new_integer_along(1:2)) expect_identical(dbl_along(1:2), new_double_along(1:2)) expect_identical(chr_along(1:2), new_character_along(1:2)) expect_identical(cpl_along(1:2), new_complex_along(1:2)) expect_identical(raw_along(1:2), new_raw_along(1:2)) expect_identical(bytes_along(1:2), new_raw_along(1:2)) expect_identical(list_along(1:2), new_list_along(1:2)) }) rlang/tests/testthat/test-vec.R0000644000176200001440000000336113241233650016236 0ustar liggesuserscontext("vec") test_that("can poke a range to a vector", { y <- 11:15 x <- 1:5 x_addr <- sxp_address(x) expect_error(vec_poke_range(x, 2L, y, 2L, 6L), "too small") vec_poke_range(x, 2L, y, 2L, 4L) expect_identical(x, int(1L, 12:14L, 5L)) expect_identical(x_addr, sxp_address(x)) }) test_that("can poke `n` elements to a vector", { y <- 11:15 x <- 1:5 x_addr <- sxp_address(x) expect_error(vec_poke_n(x, 2L, y, 2L, 5L), "too small") vec_poke_n(x, 2L, y, 2L, 4L) expect_identical(x, int(1L, 12:15)) expect_identical(x_addr, sxp_address(x)) }) test_that("can poke to a vector with default parameters", { y <- 11:15 x <- 1:5 x_addr <- sxp_address(x) vec_poke_range(x, 1L, y) expect_identical(x, y) expect_identical(x_addr, sxp_address(x)) x <- 1:5 x_addr <- sxp_address(x) vec_poke_n(x, 1L, y) expect_identical(x, y) expect_identical(x_addr, sxp_address(x)) }) test_that("can poke to a vector with double parameters", { y <- 11:15 x <- 1:5 x_addr <- sxp_address(x) vec_poke_range(x, 2, y, 2, 5) expect_identical(x, int(1L, 12:15L)) expect_identical(x_addr, sxp_address(x)) y <- 11:15 x <- 1:5 x_addr <- sxp_address(x) vec_poke_n(x, 2, y, 2, 4) expect_identical(x, int(1L, 12:15)) expect_identical(x_addr, sxp_address(x)) }) test_that("vector pokers fail if parameters are not integerish", { y <- 11:15 x <- 1:5 expect_error(vec_poke_n(x, 2.5, y, 2L, 5L), "integerish") expect_error(vec_poke_n(x, 2L, y, 2.5, 5L), "integerish") expect_error(vec_poke_n(x, 2L, y, 2L, 5.5), "integerish") expect_error(vec_poke_range(x, 2.5, y, 2L, 4L), "integerish") expect_error(vec_poke_range(x, 2L, y, 2.5, 4L), "integerish") expect_error(vec_poke_range(x, 2L, y, 2L, 4.5), "integerish") }) rlang/tests/testthat/test-parse.R0000644000176200001440000000204413241233650016570 0ustar liggesuserscontext("parse") test_that("parse_quo() etc return quosures", { expect_identical(parse_quo("foo(bar)", "base"), set_env(quo(foo(bar)), base_env())) expect_identical(parse_quos("foo(bar)\n mtcars", "base"), list(set_env(quo(foo(bar)), base_env()), set_env(quo(mtcars), base_env()))) }) test_that("parse_expr() requires scalar character", { expect_error(parse_expr(letters), "`x` must be a string or a R connection") }) test_that("parse_quosure() and parse_quosures() are deprecated", { with_verbose_retirement({ expect_warning(parse_quosure("foo"), "soft-deprecated") expect_warning(parse_quosures("foo; bar"), "soft-deprecated") }) }) test_that("temporary connections are closed", { path <- tempfile("file") cat("1; 2; mtcars", file = path) conn <- file(path) parse_exprs(conn) expect_error(summary(conn), "invalid connection") }) test_that("parse_expr() throws meaningful error messages", { expect_error(parse_expr(""), "No expression to parse") expect_error(parse_expr("foo; bar"), "More than one expression parsed") }) rlang/tests/testthat/helper-capture.R0000644000176200001440000000153113241233650017421 0ustar liggesusers named <- function(x) { set_names(x, names2(x)) } named_list <- function(...) { named(list(...)) } quos_list <- function(...) { set_attrs(named_list(...), class = "quosures") } expect_error_ <- function(object, ...) { expect_error(object, ...) } expect_warning_ <- function(object, ...) { expect_warning(object, ...) } expect_identical_ <- function(object, expected, ...) { expect_identical(object, expected, ...) } expect_equal_ <- function(object, expected, ...) { expect_equal(object, expected, ...) } expect_no_warning <- function(object, ...) { expect_warning(!!enquo(object), NA, ...) } expect_no_warning_ <- function(object, ...) { expect_warning(object, NA, ...) } expect_no_error <- function(object, ...) { expect_error(!!enquo(object), NA, ...) } expect_no_error_ <- function(object, ...) { expect_error(object, NA, ...) } rlang/tests/testthat/test-quotation.R0000644000176200001440000003327013241233650017506 0ustar liggesuserscontext("quotation") test_that("quos() creates quosures", { fs <- quos(x = 1 + 2, y = 2 + 3) expect_identical(fs$x, as_quosure(~ 1 + 2)) expect_identical(fs$y, as_quosure(~ 2 + 3)) }) test_that("quos() captures correct environment", { fn <- function(x = a + b, ...) { list(dots = quos(x = x, y = a + b, ...), env = environment()) } out <- fn(z = a + b) expect_identical(get_env(out$dots$x), out$env) expect_identical(get_env(out$dots$y), out$env) expect_identical(get_env(out$dots$z), get_env()) }) test_that("dots are interpolated", { fn <- function(...) { baz <- "baz" fn_var <- quo(baz) g(..., toupper(!! fn_var)) } g <- function(...) { foo <- "foo" g_var <- quo(foo) h(toupper(!! g_var), ...) } h <- function(...) { quos(...) } bar <- "bar" var <- quo(bar) dots <- fn(toupper(!!var)) expect_identical(map(dots, deparse), named_list("~toupper(~foo)", "~toupper(~bar)", "~toupper(~baz)")) expect_identical(map(dots, eval_tidy), named_list("FOO", "BAR", "BAZ")) }) test_that("dots capture is stack-consistent", { fn <- function(...) { g(quos(...)) } g <- function(dots) { h(dots, foo(bar)) } h <- function(dots, ...) { dots } expect_identical(fn(foo(baz)), quos_list(quo(foo(baz)))) }) test_that("dots can be spliced in", { fn <- function(...) { var <- "var" list( out = g(!!! quos(...), bar(baz), !!! list(a = var, b = ~foo)), env = get_env() ) } g <- function(...) { quos(...) } out <- fn(foo(bar)) expected <- quos_list( quo(foo(bar)), set_env(quo(bar(baz)), out$env), a = quo("var"), b = set_env(quo(!! with_env(out$env, ~foo)), out$env) ) expect_identical(out$out, expected) }) test_that("spliced dots are wrapped in formulas", { args <- alist(x = var, y = foo(bar)) expect_identical(quos(!!! args), quos_list(x = quo(var), y = quo(foo(bar)))) }) test_that("dot names are interpolated", { var <- "baz" expect_identical(quos(!!var := foo, !!toupper(var) := bar), quos_list(baz = quo(foo), BAZ = quo(bar))) expect_identical(quos(!!var := foo, bar), quos_list(baz = quo(foo), quo(bar))) var <- quote(baz) expect_identical(quos(!!var := foo), quos_list(baz = quo(foo))) }) test_that("corner cases are handled when interpolating dot names", { var <- na_chr expect_identical(names(quos(!!var := NULL)), "NA") var <- NULL expect_error(quos(!!var := NULL), "must be a string or a symbol") }) test_that("definitions are interpolated", { var1 <- "foo" var2 <- "bar" dots <- dots_definitions(def = foo(!!var1) := bar(!!var2)) pat <- list(lhs = quo(foo("foo")), rhs = quo(bar("bar"))) expect_identical(dots$defs$def, pat) }) test_that("dots are forwarded to named arguments", { outer <- function(...) inner(...) inner <- function(...) fn(...) fn <- function(x) enquo(x) env <- child_env(get_env()) expect_identical(with_env(env, outer(foo(bar))), new_quosure(quote(foo(bar)), env)) }) test_that("pronouns are scoped throughout nested captures", { outer <- function(data, ...) eval_tidy(quos(...)[[1]], data = data) inner <- function(...) map(quos(...), eval_tidy) data <- list(foo = "bar", baz = "baz") baz <- "bazz" expect_identical(outer(data, inner(foo, baz)), set_names(list("bar", "baz"), c("", ""))) }) test_that("Can supply := with LHS even if .named = TRUE", { expect_warning(regexp = NA, expect_identical( quos(!!"nm" := 2, .named = TRUE), quos_list(nm = as_quosure(quote(2), empty_env())) )) }) test_that("Can't supply both `=` and `:=`", { expect_error(regexp = "both `=` and `:=`", quos(foobar = !!"nm" := 2)) expect_error(regexp = "both `=` and `:=`", quos(foobar = !!"nm" := 2, .named = TRUE)) }) test_that("RHS of tidy defs are unquoted", { expect_identical(quos(foo := !!"bar"), quos_list(foo = as_quosure(quote("bar"), empty_env()))) }) test_that("can capture empty list of dots", { fn <- function(...) quos(...) expect_identical(fn(), quos_list()) }) test_that("quosures are spliced before serialisation", { quosures <- quos(!! quo(foo(!! quo(bar))), .named = TRUE) expect_identical(names(quosures), "foo(bar)") }) test_that("missing arguments are captured", { q <- quo() expect_true(is_missing(quo_get_expr(q))) expect_identical(quo_get_env(q), empty_env()) }) test_that("empty quosures are forwarded", { inner <- function(x) enquo(x) outer <- function(x) inner(!! enquo(x)) expect_identical(outer(), quo()) }) test_that("quos() captures missing arguments", { expect_identical(quos(, , .ignore_empty = "none"), quos_list(quo(), quo()), c("", "")) }) test_that("quos() ignores missing arguments", { expect_identical(quos(, , "foo", ), quos_list(quo(), quo(), new_quosure("foo", empty_env()))) expect_identical(quos(, , "foo", , .ignore_empty = "all"), quos_list(new_quosure("foo", empty_env()))) }) test_that("quosured literals are forwarded as is", { expect_identical(quo(!! quo(NULL)), new_quosure(NULL, empty_env())) expect_identical(quos(!! quo(10L)), set_names(quos_list(new_quosure(10L, empty_env())), "")) }) test_that("expr() returns missing argument", { expect_true(is_missing(expr())) }) test_that("expr() supports forwarded arguments", { fn <- function(...) g(...) g <- function(...) expr(...) expect_identical(fn(foo), quote(foo)) }) test_that("can take forced arguments", { fn <- function(allow, x) { force(x) captureArgInfo(x) } expect_identical(fn(TRUE, letters), list(expr = letters, env = empty_env())) if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } expect_error(lapply(1:2, captureArgInfo), "must be an argument name") args <- list(list(expr = 1L, env = empty_env()), list(expr = 2L, env = empty_env())) expect_identical(lapply(1:2, function(x) captureArgInfo(x)), args) }) test_that("capturing an argument that doesn't exist fails", { fn <- function(x) captureArgInfo(`_foobar`) expect_error(fn(), "object '_foobar' not found") fn <- function() enquo(`_foobar`) expect_error(fn(), "not found") fn <- function() enexpr(`_foobar`) expect_error(fn(), "not found") expect_error((function() rlang::enexpr(`_foobar`))(), "not found") }) test_that("can capture arguments across ancestry", { y <- "foo" fn <- function() captureArgInfo(y) expect_identical(fn(), list(expr = "foo", env = empty_env())) }) test_that("can capture arguments that do exist", { fn <- function() { x <- 10L captureArgInfo(x) } expect_identical(fn(), list(expr = 10L, env = empty_env())) }) test_that("can capture missing argument", { expect_identical(captureArgInfo(), list(expr = missing_arg(), env = empty_env())) }) test_that("serialised unicode in `:=` LHS is unserialised", { nms <- with_latin1_locale({ exprs <- exprs("\u5e78" := 10) names(exprs) }) expect_identical(as_bytes(nms), as_bytes("\u5e78")) }) test_that("exprs() supports auto-naming", { expect_identical(exprs(foo(bar), b = baz(), .named = TRUE), list(`foo(bar)` = quote(foo(bar)), b = quote(baz()))) }) test_that("dots_interp() supports unquoting", { expect_identical(exprs(!!(1 + 2)), named_list(3)) expect_identical(exprs(!!(1 + 1) + 2), named_list(quote(2 + 2))) expect_identical(exprs(!!(1 + 1) + 2 + 3), named_list(quote(2 + 2 + 3))) expect_identical(exprs(!!"foo" := bar), named_list(foo = quote(bar))) }) test_that("dots_interp() has no side effect", { f <- function(x) exprs(!! x + 2) expect_identical(f(1), named_list(quote(1 + 2))) expect_identical(f(2), named_list(quote(2 + 2))) }) test_that("exprs() handles forced arguments", { if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } exprs <- list(named_list(1L), named_list(2L)) expect_identical(lapply(1:2, function(...) exprs(...)), exprs) expect_identical(lapply(1:2, exprs), exprs) }) test_that("quos() handles forced arguments", { if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } quos <- list(quos_list(quo(1L)), quos_list(quo(2L))) expect_identical(lapply(1:2, function(...) quos(...)), quos) expect_identical(lapply(1:2, quos), quos) }) test_that("enexpr() and enquo() handle forced arguments", { foo <- "foo" expect_identical(enexpr(foo), "foo") expect_identical(enquo(foo), quo("foo")) if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } expect_identical(lapply(1:2, function(x) enexpr(x)), list(1L, 2L)) expect_identical(lapply(1:2, function(x) enquo(x)), list(quo(1L), quo(2L))) }) test_that("default arguments are properly captured (#201)", { fn <- function(x = x) enexpr(x) expect_identical(fn(), quote(x)) # This is just for consistency. This causes an infinite recursion # when evaluated as Hong noted fn <- function(x = x) list(enquo(x), quo(x)) out <- fn() expect_identical(out[[1]], out[[2]]) }) test_that("names-unquoting can be switched off", { foo <- "foo" bar <- "bar" expect_identical(exprs(foo := bar, .unquote_names = FALSE), named_list(quote(foo := bar))) expect_identical(exprs(!! foo := !! bar, .unquote_names = FALSE), named_list(quote("foo" := "bar"))) expect_identical(quos(foo := bar, .unquote_names = FALSE), quos_list(new_quosure(quote(foo := bar)))) expect_identical(quos(!! foo := !! bar, .unquote_names = FALSE), quos_list(new_quosure(quote("foo" := "bar")))) }) test_that("endots() captures arguments", { # enquos() fn <- function(foo, ..., bar) enquos(foo, bar, ...) expect_identical(fn(arg1, arg2, bar = arg3()), quos(arg1, arg3(), arg2)) # enexprs() fn <- function(foo, ..., bar) enexprs(foo, bar, ...) expect_identical(fn(arg1, arg2, bar = arg3()), exprs(arg1, arg3(), arg2)) }) test_that("endots() requires symbols", { expect_error(enquos(foo(bar)), "must be argument names") expect_error(enquos(1), "must be argument names") expect_error(enquos("foo"), "must be argument names") expect_error(enexprs(foo(bar)), "must be argument names") expect_error(enexprs(1), "must be argument names") expect_error(enexprs("foo"), "must be argument names") }) test_that("endots() returns a named list", { # enquos() fn <- function(foo, bar) enquos(foo, bar) expect_identical(names(fn()), c("", "")) fn <- function(arg, ...) enquos(other = arg, ...) expect_identical(fn(arg = 1, b = 2), quos(other = 1, b = 2)) # enexprs() fn <- function(foo, bar) enexprs(foo, bar) expect_identical(names(fn()), c("", "")) fn <- function(arg, ...) enexprs(other = arg, ...) expect_identical(fn(arg = 1, b = 2), exprs(other = 1, b = 2)) }) test_that("endots() captures missing arguments", { # enquos() fn <- function(foo) enquos(foo)[[1]] expect_identical(fn(), quo()) fn <- function(...) enquos(...) expect_identical(fn(), quos()) # enexprs() fn <- function(foo) enexprs(foo)[[1]] expect_identical(fn(), expr()) fn <- function(...) enexprs(...) expect_identical(fn(), exprs()) }) test_that("endots() supports `.named`", { # enquos() fn <- function(arg, ...) enquos(arg, ..., .named = TRUE) expect_identical(fn(foo, bar), quos(foo = foo, bar = bar)) # enexprs() fn <- function(arg, ...) enexprs(arg, ..., .named = TRUE) expect_identical(fn(foo, bar), exprs(foo = foo, bar = bar)) }) test_that("endots() supports `.unquote_names`", { # enquos() fn <- function(...) enquos(..., .unquote_names = TRUE) expect_identical(fn(!!"foo" := bar), quos(foo = bar)) fn <- function(...) enquos(..., .unquote_names = FALSE) expect_identical(fn(!!"foo" := bar), quos(!!"foo" := bar, .unquote_names = FALSE)) # enexprs() fn <- function(...) enexprs(..., .unquote_names = TRUE) expect_identical(fn(!!"foo" := bar), exprs(foo = bar)) fn <- function(...) enexprs(..., .unquote_names = FALSE) expect_identical(fn(!!"foo" := bar), exprs(!!"foo" := bar, .unquote_names = FALSE)) }) test_that("endots() supports `.ignore_empty`", { # enquos() fn <- function(...) enquos(..., .ignore_empty = "all") expect_identical(fn(, ), quos()) fn <- function(...) enquos(..., .ignore_empty = "trailing") expect_identical(fn(foo, ), quos(foo)) # enexprs() fn <- function(...) enexprs(..., .ignore_empty = "all") expect_identical(fn(, ), exprs()) fn <- function(...) enexprs(..., .ignore_empty = "trailing") expect_identical(fn(foo, ), exprs(foo)) }) test_that("ensyms() captures multiple symbols", { fn <- function(arg, ...) ensyms(arg, ...) expect_identical(fn(foo, bar, baz), exprs(foo, bar, baz)) expect_error(fn(foo()), "Must supply symbols or strings") }) test_that("enquos() works with lexically scoped dots", { capture <- function(...) { eval_bare(quote(enquos(...)), child_env(env())) } expect_identical(capture("foo"), quos_list(quo("foo"))) }) test_that("enquo() works with lexically scoped arguments", { capture <- function(arg) { eval_bare(quote(enquo(arg)), child_env(env())) } expect_identical(capture(foo), quo(foo)) }) test_that("dots_definitions() uses tidy eval", { var1 <- "foo" var2 <- "bar" dots <- dots_definitions(pat = foo(!!var1) := bar(!!var2)) pat <- list(lhs = quo(foo("foo")), rhs = quo(bar("bar"))) expect_identical(dots$defs$pat, pat) }) test_that("dots_definitions() accepts other types of arguments", { dots <- dots_definitions(A = a := b, B = c) expect_identical(dots$defs$A, list(lhs = quo(a), rhs = quo(b))) expect_identical(dots$dots$B, quo(c)) }) test_that("closures are captured with their calling environment", { expect_reference(quo_get_env(quo(!!function() NULL)), environment()) }) test_that("the missing argument is captured", { expect_equal_(quos(!!missing_arg()), quos(, )) fn <- function(x) { g(!!enquo(x)) } g <- function(...) { quos(...) } expect_equal_(fn(), quos(!!missing_arg())) }) test_that("missing names are forwarded", { x <- set_names(1:2, c(NA, NA)) expect_identical_(names(exprs(!!!x)), chr(na_chr, na_chr)) }) rlang/tests/testthat/test-vec-coerce.R0000644000176200001440000000301113241233650017464 0ustar liggesuserscontext("vec-coerce") test_that("no method dispatch", { as.logical.foo <- function(x) "wrong" expect_identical(as_integer(structure(TRUE, class = "foo")), 1L) as.list.foo <- function(x) "wrong" expect_identical(as_list(structure(1:10, class = "foo")), as.list(1:10)) }) test_that("input is left intact", { x <- structure(TRUE, class = "foo") y <- as_integer(x) expect_identical(x, structure(TRUE, class = "foo")) }) test_that("as_list() zaps attributes", { expect_identical(as_list(structure(list(), class = "foo")), list()) }) test_that("as_list() only coerces vector or dictionary types", { expect_identical(as_list(1:3), list(1L, 2L, 3L)) expect_error(as_list(quote(symbol)), "a symbol to a list") }) test_that("as_list() bypasses environment method and leaves input intact", { as.list.foo <- function(x) "wrong" x <- structure(child_env(NULL), class = "foo") y <- as_list(x) expect_is(x, "foo") expect_identical(y, set_names(list(), character(0))) }) test_that("as_integer() and as_logical() require integerish input", { expect_error(as_integer(1.5), "a fractional double vector to an integer vector") expect_error(as_logical(1.5), "a fractional double vector to a logical vector") }) test_that("names are preserved", { nms <- as.character(1:3) x <- set_names(1:3, nms) expect_identical(names(as_double(x)), nms) expect_identical(names(as_list(x)), nms) }) test_that("can convert strings (#138)", { expect_identical(as_character("a"), "a") expect_identical(as_list("a"), list("a")) }) rlang/tests/testthat/test-types.R0000644000176200001440000001052113241233650016621 0ustar liggesuserscontext("types") test_that("predicates match definitions", { expect_true(is_character(letters, 26)) expect_false(is_character(letters, 1)) expect_false(is_list(letters, 26)) expect_true(is_list(mtcars, 11)) expect_false(is_list(mtcars, 0)) expect_false(is_double(mtcars, 11)) }) test_that("can bypass string serialisation", { bar <- chr(list("cafe", string(c(0x63, 0x61, 0x66, 0xE9))), .encoding = "latin1") bytes <- list(bytes(c(0x63, 0x61, 0x66, 0x65)), bytes(c(0x63, 0x61, 0x66, 0xE9))) expect_identical(map(bar, as_bytes), bytes) expect_identical(str_encoding(bar[[2]]), "latin1") }) test_that("pattern match on string encoding", { expect_true(is_character(letters, encoding = "unknown")) expect_false(is_character(letters, encoding = "UTF-8")) chr <- chr(c("foo", "fo\uE9")) expect_false(is_character(chr, encoding = "UTF-8")) expect_false(is_character(chr, encoding = "unknown")) expect_true(is_character(chr, encoding = c("unknown", "UTF-8"))) }) test_that("type_of() returns correct type", { expect_identical(type_of("foo"), "string") expect_identical(type_of(letters), "character") expect_identical(type_of(base::`$`), "primitive") expect_identical(type_of(base::list), "primitive") expect_identical(type_of(base::eval), "closure") expect_identical(type_of(~foo), "formula") expect_identical(type_of(quo(foo)), "formula") expect_identical(type_of(quote(a := b)), "definition") expect_identical(type_of(quote(foo())), "language") }) test_that("lang_type_of() returns correct lang subtype", { expect_identical(lang_type_of(quote(foo())), "named") expect_identical(lang_type_of(quote(foo::bar())), "namespaced") expect_identical(lang_type_of(quote(foo@bar())), "recursive") lang <- quote(foo()) node_poke_car(lang, 10) expect_error(lang_type_of(lang), "corrupt") node_poke_car(lang, base::list) expect_identical(lang_type_of(lang), "inlined") }) test_that("types are friendly", { expect_identical(friendly_type("character"), "a character vector") expect_identical(friendly_type("integer"), "an integer vector") expect_identical(friendly_type("language"), "a call") }) test_that("is_integerish() heeds type requirement", { for (n in 0:2) { expect_true(is_integerish(integer(n))) expect_true(is_integerish(double(n))) expect_false(is_integerish(double(n + 1) + .000001)) } types <- c("logical", "complex", "character", "expression", "list", "raw") for (type in types) { expect_false(is_integerish(vector(type))) } }) test_that("is_integerish() heeds length requirement", { for (n in 0:2) { expect_true(is_integerish(double(n), n = n)) expect_false(is_integerish(double(n), n = n + 1)) } }) test_that("non finite double values are integerish", { expect_true(is_integerish(dbl(1, Inf, -Inf, NaN), finite = NULL)) expect_true(is_integerish(dbl(1, NA))) expect_true(is_integerish(int(1, NA))) }) test_that("check finiteness", { expect_true( is_double(dbl(1, 2), finite = TRUE)) expect_true(is_integerish(dbl(1, 2), finite = TRUE)) expect_false( is_double(dbl(1, Inf), finite = TRUE)) expect_false(is_integerish(dbl(1, Inf), finite = TRUE)) expect_false( is_double(dbl(1, Inf), finite = FALSE)) expect_false(is_integerish(dbl(1, Inf), finite = FALSE)) expect_true( is_double(dbl(-Inf, Inf), finite = FALSE)) expect_true(is_integerish(dbl(-Inf, Inf), finite = FALSE)) }) test_that("scalar predicates heed type and length", { expect_true_false <- function(pred, pass, fail_len, fail_type) { expect_true(pred(pass)) expect_false(pred(fail_len)) expect_false(pred(fail_type)) } expect_true_false(is_scalar_list, list(1), list(1, 2), logical(1)) expect_true_false(is_scalar_atomic, logical(1), logical(2), list(1)) expect_true_false(is_scalar_vector, list(1), list(1, 2), quote(x)) expect_true_false(is_scalar_vector, logical(1), logical(2), function() {}) expect_true_false(is_scalar_integer, integer(1), integer(2), double(1)) expect_true_false(is_scalar_double, double(1), double(2), integer(1)) expect_true_false(is_scalar_character, character(1), character(2), logical(1)) expect_true_false(is_string, character(1), character(2), logical(1)) expect_true_false(is_scalar_logical, logical(1), logical(2), character(1)) expect_true_false(is_scalar_raw, raw(1), raw(2), NULL) expect_true_false(is_scalar_bytes, raw(1), raw(2), NULL) }) rlang/tests/testthat/test-conditions.R0000644000176200001440000001407313241233650017634 0ustar liggesuserscontext("conditions") # ---------------------------------------------- test_that("cnd() constructs all fields", { cond <- cnd("cnd_class", .msg = "cnd message") expect_equal(conditionMessage(cond), "cnd message") expect_is(cond, "cnd_class") }) test_that("cnd() throws with unnamed fields", { expect_error(cnd("class", "msg", 10), "must have named data fields") }) test_that("cnd_signal() creates muffle restarts", { withCallingHandlers(cnd_signal("foo", .mufflable = TRUE), foo = function(c) { expect_true(rst_exists("muffle")) expect_is(c, "mufflable") } ) }) test_that("cnd_signal() includes call info", { cnd <- cnd("cnd", .call = quote(foo(bar))) fn <- function(...) cnd_signal(cnd, .call = call) call <- FALSE with_handlers(fn(foo(bar)), cnd = inplace(function(c) { expect_identical(c$.call, quote(fn(foo(bar)))) expect_null(conditionCall(c)) })) call <- TRUE with_handlers(fn(foo(bar)), cnd = inplace(function(c) { expect_identical(conditionCall(c), quote(fn(foo(bar)))) })) call <- NULL with_handlers(fn(foo(bar)), cnd = inplace(function(c) { expect_identical(conditionCall(c), quote(foo(bar))) })) wrapper <- function(...) fn(...) call <- 1 with_handlers(wrapper(foo(bar)), cnd = inplace(function(c) { expect_equal(conditionCall(c), quote(fn(...))) })) call <- 2 with_handlers(wrapper(foo(bar)), cnd = inplace(function(c) { expect_equal(conditionCall(c), quote(wrapper(foo(bar)))) })) }) test_that("abort() includes call info", { fn <- function(...) abort("abort", "cnd", call = call) call <- FALSE with_handlers(fn(foo(bar)), cnd = exiting(function(c) { expect_identical(c$.call, quote(fn(foo(bar)))) expect_null(conditionCall(c)) })) call <- TRUE with_handlers(fn(foo(bar)), cnd = exiting(function(c) { expect_identical(conditionCall(c), quote(fn(foo(bar)))) })) }) test_that("abort() accepts call number", { fn <- function(...) abort("abort", "cnd", call = call) wrapper <- function(...) fn(...) call <- FALSE with_handlers(wrapper(foo(bar)), cnd = exiting(function(c) { expect_equal(c$.call, quote(fn(...))) expect_null(conditionCall(c)) })) call <- TRUE with_handlers(wrapper(foo(bar)), cnd = exiting(function(c) { expect_equal(c$.call, quote(fn(...))) expect_equal(conditionCall(c), quote(fn(...))) })) call <- 1 with_handlers(wrapper(foo(bar)), cnd = exiting(function(c) { expect_equal(c$.call, quote(fn(...))) expect_equal(conditionCall(c), quote(fn(...))) })) call <- 2 with_handlers(wrapper(foo(bar)), cnd = exiting(function(c) { expect_equal(c$.call, quote(wrapper(foo(bar)))) expect_equal(conditionCall(c), quote(wrapper(foo(bar)))) })) }) test_that("error when msg is not a string", { expect_error(warn(letters), "must be a string") }) context("restarts") # ------------------------------------------------ test_that("restarts are established", { with_restarts(foo = function() {}, expect_true(rst_exists("foo"))) }) context("handlers") # ------------------------------------------------ test_that("Local handlers can muffle mufflable conditions", { signal_mufflable <- function() cnd_signal("foo", with_muffle = TRUE) muffling_handler <- inplace(function(c) NULL, muffle = TRUE) non_muffling_handler <- inplace(function(c) NULL, muffle = FALSE) expect_error(regexp = "not muffled!", withCallingHandlers(foo = function(c) stop("not muffled!"), { withCallingHandlers(foo = non_muffling_handler, signal_mufflable()) })) expect_error(regexp = NA, withCallingHandlers(foo = function(c) stop("not muffled!"), { withCallingHandlers(foo = muffling_handler, signal_mufflable()) })) }) test_that("with_handlers() establishes inplace and exiting handlers", { handlers <- list( error = exiting(function(c) "caught error"), message = exiting(function(c) "caught message"), warning = inplace(function(c) "warning"), foobar = inplace(function(c) cat("foobar")) ) expect_equal(with_handlers(identity(letters), splice(handlers)), identity(letters)) expect_equal(with_handlers(stop(letters), splice(handlers)), "caught error") expect_equal(with_handlers(message(letters), splice(handlers)), "caught message") expect_warning(expect_equal(with_handlers({ warning("warn!"); letters }, splice(handlers)), identity(letters)), "warn!") expect_output(expect_equal(with_handlers({ cnd_signal("foobar"); letters }, splice(handlers)), identity(letters)), "foobar") }) test_that("set_names2() fills in empty names", { chr <- c("a", b = "B", "c") expect_equal(set_names2(chr), c(a = "a", b = "B", c = "c")) }) test_that("restarting() handlers pass along all requested arguments", { signal_foo <- function() { cnd_signal("foo", foo_field = "foo_field") } fn <- function() { with_handlers(signal_foo(), foo = restart_handler) } restart_handler <- restarting("rst_foo", a = "a", splice(list(b = "b")), .fields = c(field_arg = "foo_field") ) rst_foo <- function(a, b, field_arg) { expect_equal(list(a, b, field_arg), list("a", "b", "foo_field")) } with_restarts(fn(), rst_foo = rst_foo) }) test_that("cnd_signal() returns NULL invisibly", { expect_identical(withVisible(cnd_signal("foo")), withVisible(invisible(NULL))) }) test_that("cnd_signal() accepts character vectors (#195)", { expect <- inplace(function(cnd) { expect_identical(class(cnd), c("mufflable", "foo", "bar", "condition")) }) with_handlers(cnd_signal(c("foo", "bar")), foo = expect) }) test_that("cnd_warn() transforms condition to warning", { cnd <- cnd("type", attr = "baz", .msg = "warned") expect_warning(cnd_warn(cnd), "warned") expect_warning(cnd_warn("type", .msg = "warned"), "warned") }) test_that("cnd_inform() transforms condition to message", { cnd <- cnd("type", attr = "baz", .msg = "informed") expect_message(cnd_inform(cnd), "informed") expect_message(cnd_inform("type", .msg = "informed"), "informed") }) test_that("cnd_abort() adds correct S3 classes for errors", { expect_is(catch_cnd(cnd_abort("type")), "error") expect_error(cnd_abort("type")) }) rlang/tests/testthat/test-call.R0000644000176200001440000001522513241233650016376 0ustar liggesuserscontext("call") # Creation ---------------------------------------------------------------- test_that("character vector must be length 1", { expect_error(call2(letters), "must be a length 1 string") }) test_that("args can be specified individually or as list", { out <- call2("f", a = 1, splice(list(b = 2))) expect_equal(out, quote(f(a = 1, b = 2))) }) test_that("creates namespaced calls", { expect_identical(call2("fun", foo = quote(baz), .ns = "bar"), quote(bar::fun(foo = baz))) }) test_that("fails with non-callable objects", { expect_error(call2(1), "non-callable") expect_error(call2(get_env()), "non-callable") }) test_that("succeeds with literal functions", { expect_error(regex = NA, call2(base::mean, 1:10)) expect_error(regex = NA, call2(base::list, 1:10)) }) # Standardisation --------------------------------------------------------- test_that("can standardise call frame", { fn <- function(foo = "bar") call_standardise(call_frame()) expect_identical(fn(), quote(fn())) expect_identical(fn("baz"), quote(fn(foo = "baz"))) }) test_that("can modify call frame", { fn <- function(foo = "bar") call_modify(call_frame(), baz = "bam", .standardise = TRUE) expect_identical(fn(), quote(fn(baz = "bam"))) expect_identical(fn("foo"), quote(fn(foo = "foo", baz = "bam"))) }) # Modification ------------------------------------------------------------ test_that("can modify formulas inplace", { expect_identical(call_modify(~matrix(bar), quote(foo)), ~matrix(bar, foo)) }) test_that("optional standardisation", { expect_identical(call_modify(~matrix(bar), quote(foo), .standardise = TRUE), ~matrix(data = bar, foo)) }) test_that("new args inserted at end", { call <- quote(matrix(1:10)) out <- call_modify(call, nrow = 3, .standardise = TRUE) expect_equal(out, quote(matrix(data = 1:10, nrow = 3))) }) test_that("new args replace old", { call <- quote(matrix(1:10)) out <- call_modify(call, data = 3, .standardise = TRUE) expect_equal(out, quote(matrix(data = 3))) }) test_that("can modify calls for primitive functions", { expect_identical(call_modify(~list(), foo = "bar", .standardise = TRUE), ~list(foo = "bar")) }) test_that("can modify calls for functions containing dots", { expect_identical(call_modify(~mean(), na.rm = TRUE, .standardise = TRUE), ~mean(na.rm = TRUE)) }) test_that("accepts unnamed arguments", { expect_identical( call_modify(~get(), "foo", envir = "bar", "baz", .standardise = TRUE), ~get(envir = "bar", "foo", "baz") ) }) test_that("fails with duplicated arguments", { expect_error(call_modify(~mean(), na.rm = TRUE, na.rm = FALSE), "Duplicate arguments") expect_error(call_modify(~mean(), TRUE, FALSE), NA) }) # Utils -------------------------------------------------------------- test_that("NULL is a valid language object", { expect_true(is_expression(NULL)) }) test_that("is_call() pattern-matches", { expect_true(is_call(quote(foo(bar)), "foo")) expect_false(is_call(quote(foo(bar)), "bar")) expect_true(is_call(quote(foo(bar)), quote(foo))) expect_true(is_call(quote(foo(bar)), "foo", n = 1)) expect_false(is_call(quote(foo(bar)), "foo", n = 2)) expect_true(is_call(quote(+3), n = 1)) expect_true(is_call(quote(3 + 3), n = 2)) expect_true(is_call(quote(foo::bar())), quote(foo::bar())) expect_false(is_call(1)) expect_false(is_call(NULL)) }) test_that("is_call() vectorises name", { expect_false(is_call(quote(foo::bar), c("fn", "fn2"))) expect_true(is_call(quote(foo::bar), c("fn", "::"))) expect_true(is_call(quote(foo::bar), quote(`::`))) expect_true(is_call(quote(foo::bar), list(quote(`@`), quote(`::`)))) expect_false(is_call(quote(foo::bar), list(quote(`@`), quote(`:::`)))) }) test_that("call_name() handles namespaced and anonymous calls", { expect_equal(call_name(quote(foo::bar())), "bar") expect_equal(call_name(quote(foo:::bar())), "bar") expect_null(call_name(quote(foo@bar()))) expect_null(call_name(quote(foo$bar()))) expect_null(call_name(quote(foo[[bar]]()))) expect_null(call_name(quote(foo()()))) expect_null(call_name(quote(foo::bar()()))) expect_null(call_name(quote((function() NULL)()))) }) test_that("call_name() handles formulas and frames", { expect_identical(call_name(~foo(baz)), "foo") fn <- function() call_name(call_frame()) expect_identical(fn(), "fn") }) test_that("call_fn() extracts function", { fn <- function() call_fn(call_frame()) expect_identical(fn(), fn) expect_identical(call_fn(~matrix()), matrix) }) test_that("call_fn() looks up function in `env`", { env <- local({ fn <- function() "foo" get_env() }) expect_identical(call_fn(quote(fn()), env = env), env$fn) }) test_that("Inlined functions return NULL name", { call <- quote(fn()) call[[1]] <- function() {} expect_null(call_name(call)) }) test_that("call_args() and call_args_names()", { expect_identical(call_args(~fn(a, b)), set_names(list(quote(a), quote(b)), c("", ""))) fn <- function(a, b) call_args_names(call_frame()) expect_identical(fn(a = foo, b = bar), c("a", "b")) }) test_that("qualified and namespaced symbols are recognised", { expect_true(is_qualified_call(quote(foo@baz()))) expect_true(is_qualified_call(quote(foo::bar()))) expect_false(is_qualified_call(quote(foo()()))) expect_false(is_namespaced_call(quote(foo@bar()))) expect_true(is_namespaced_call(quote(foo::bar()))) }) test_that("can specify ns in namespaced predicate", { expr <- quote(foo::bar()) expect_false(is_namespaced_call(expr, quote(bar))) expect_true(is_namespaced_call(expr, quote(foo))) expect_true(is_namespaced_call(expr, "foo")) }) test_that("can specify ns in is_call()", { expr <- quote(foo::bar()) expect_true(is_call(expr, ns = NULL)) expect_false(is_call(expr, ns = "")) expect_false(is_call(expr, ns = "baz")) expect_true(is_call(expr, ns = "foo")) expect_true(is_call(expr, name = "bar", ns = "foo")) expect_false(is_call(expr, name = "baz", ns = "foo")) }) test_that("can unnamespace calls", { expect_identical(call_unnamespace(quote(bar(baz))), quote(bar(baz))) expect_identical(call_unnamespace(quote(foo::bar(baz))), quote(bar(baz))) expect_identical(call_unnamespace(quote(foo@bar(baz))), quote(foo@bar(baz))) }) test_that("precedence of regular calls", { expect_true(call_has_precedence(quote(1 + 2), quote(foo(1 + 2)))) expect_true(call_has_precedence(quote(foo()), quote(1 + foo()))) }) test_that("precedence of associative ops", { expect_true(call_has_precedence(quote(1 + 2), quote(1 + 2 + 3), "lhs")) expect_false(call_has_precedence(quote(2 + 3), quote(1 + 2 + 3), "rhs")) expect_false(call_has_precedence(quote(1^2), quote(1^2^3), "lhs")) expect_true(call_has_precedence(quote(2^3), quote(1^2^3), "rhs")) }) rlang/tests/testthat/test-vec-squash.R0000644000176200001440000001047113241233650017540 0ustar liggesuserscontext("vec-squash") # Squashing ---------------------------------------------------------- test_that("vectors and names are squashed", { expect_identical( squash_dbl(list(a = 1e0, list(c(b = 2e1, c = 3e1), d = 4e1, list(5e2, list(e = 6e3, c(f = 7e3)))), 8e0)), c(a = 1e0, b = 2e1, c = 3e1, d = 4e1, 5e2, e = 6e3, f = 7e3, 8e0) ) }) test_that("bad outer names warn even at depth", { expect_warning(regex = "Outer names", expect_identical(squash_dbl(list(list(list(A = c(a = 1))))), c(a = 1)) ) }) test_that("lists are squashed", { expect_identical(squash(list(a = 1e0, list(c(b = 2e1, c = 3e1), d = 4e1, list(5e2, list(e = 6e3, c(f = 7e3)))), 8e0)), list(a = 1, c(b = 20, c = 30), d = 40, 500, e = 6000, c(f = 7000), 8)) }) test_that("squash_if() handles custom predicate", { is_foo <- function(x) inherits(x, "foo") || is_bare_list(x) foo <- set_attrs(list("bar"), class = "foo") x <- list(1, list(foo, list(foo, 100))) expect_identical(squash_if(x, is_foo), list(1, "bar", "bar", 100)) }) # Flattening --------------------------------------------------------- test_that("vectors and names are flattened", { expect_identical(flatten_dbl(list(a = 1, c(b = 2), 3)), c(a = 1, b = 2, 3)) expect_identical(flatten_dbl(list(list(a = 1), list(c(b = 2)), 3)), c(a = 1, b = 2, 3)) expect_error(flatten_dbl(list(1, list(list(2)), 3)), "Can't convert") }) test_that("bad outer names warn when flattening", { expect_warning(expect_identical(flatten_dbl(list(a = c(A = 1))), c(A = 1)), "Outer names") expect_warning(expect_identical(flatten_dbl(list(a = 1, list(b = c(B = 2)))), c(a = 1, B = 2)), "Outer names") }) test_that("lists are flattened", { x <- list(1, list(2, list(3, list(4)))) expect_identical(flatten(x), list(1, 2, list(3, list(4)))) expect_identical(flatten(flatten(x)), list(1, 2, 3, list(4))) expect_identical(flatten(flatten(flatten(x))), list(1, 2, 3, 4)) expect_identical(flatten(flatten(flatten(flatten(x)))), list(1, 2, 3, 4)) }) test_that("splice() requires lists", { expect_error(splice(quote(sym)), "Only lists can be spliced") }) test_that("is_spliced_bare() is TRUE for bare lists", { expect_true(is_spliced_bare(list())) }) test_that("flatten_if() handles custom predicate", { obj <- set_attrs(list(1:2), class = "foo") x <- list(obj, splice(obj), unclass(obj)) expect_identical(flatten_if(x), list(obj, obj[[1]], unclass(obj))) expect_identical(flatten_if(x, is_bare_list), list(obj, splice(obj), obj[[1]])) pred <- function(x) is_bare_list(x) || is_spliced(x) expect_identical(flatten_if(x, pred), list(obj, obj[[1]], obj[[1]])) }) test_that("flatten_if() handles external pointers", { obj <- set_attrs(list(1:2), class = "foo") x <- list(obj, splice(obj), unclass(obj)) expect_identical(flatten_if(x, rlang_test_is_spliceable), list(obj[[1]], splice(obj), unclass(obj))) ptr <- rlang_test_is_spliceable[[1]] expect_identical(flatten_if(x, ptr), list(obj[[1]], splice(obj), unclass(obj))) expect_is(rlang_test_is_spliceable, "fn_pointer") }) test_that("flatten() splices names", { expect_warning(regexp = "Outer names", expect_identical( flatten(list(a = list(A = TRUE), b = list(B = FALSE))) , list(A = TRUE, B = FALSE) ) ) expect_warning(regexp = "Outer names", expect_identical( flatten(list(a = list(TRUE), b = list(FALSE))) , list(TRUE, FALSE) ) ) }) test_that("typed flatten return typed vectors", { x <- list(list(TRUE), list(FALSE)) expect_identical(flatten_lgl(x), lgl(TRUE, FALSE)) expect_identical(flatten_int(x), int(TRUE, FALSE)) expect_identical(flatten_dbl(x), dbl(TRUE, FALSE)) expect_identical(flatten_cpl(x), cpl(TRUE, FALSE)) x <- list(list("foo"), list("bar")) expect_identical(flatten_chr(x), chr("foo", "bar")) x <- list(bytes(0L), bytes(1L)) expect_identical(flatten_raw(x), as.raw(0:1)) }) test_that("typed squash return typed vectors", { x <- list(list(list(TRUE)), list(list(FALSE))) expect_identical(squash_lgl(x), lgl(TRUE, FALSE)) expect_identical(squash_int(x), int(TRUE, FALSE)) expect_identical(squash_dbl(x), dbl(TRUE, FALSE)) expect_identical(squash_cpl(x), cpl(TRUE, FALSE)) x <- list(list(list("foo")), list(list("bar"))) expect_identical(squash_chr(x), chr("foo", "bar")) x <- list(list(bytes(0L)), list(bytes(1L))) expect_identical(squash_raw(x), as.raw(0:1)) }) rlang/tests/testthat/test-events.R0000644000176200001440000000101413241233650016756 0ustar liggesuserscontext("events") test_that("can't add an exit event at top-level", { expect_true(TRUE) # This can only be tested interactively if (FALSE) { scoped_exit(1) # Can't add an exit event at top level } }) test_that("can add an exit event within a non-top-level global frame", { local(envir = global_env(), { `_x` <- list() rlang:::scoped_exit(`_x` <- c(`_x`, "bar")) `_x` <- c(`_x`, "foo") }) expect_identical(env_get(global_env(), "_x"), list("foo", "bar")) env_unbind(global_env(), "_x") }) rlang/tests/testthat/test-env.R0000644000176200001440000002365513241233650016261 0ustar liggesuserscontext("environments") test_that("get_env() returns current frame by default", { fn <- function() expect_identical(get_env(), environment()) fn() }) test_that("env_parent() returns enclosure frame by default", { enclos_env <- child_env(pkg_env("rlang")) fn <- with_env(enclos_env, function() env_parent()) expect_identical(fn(), enclos_env) }) test_that("child_env() has correct parent", { env <- child_env(empty_env()) expect_false(env_has(env, "list", inherit = TRUE)) fn <- function() list(new = child_env(get_env()), env = environment()) out <- fn() expect_identical(env_parent(out$new), out$env) expect_identical(env_parent(child_env(NULL)), empty_env()) expect_identical(env_parent(child_env("base")), base_env()) }) test_that("env_parent() reports correct parent", { env <- child_env(child_env(NULL, obj = "b"), obj = "a") expect_identical(env_parent(env, 1)$obj, "b") expect_identical(env_parent(env, 2), empty_env()) expect_identical(env_parent(env, 3), empty_env()) }) test_that("env_tail() climbs env chain", { expect_identical(env_tail(global_env()), base_env()) }) test_that("promises are created", { env <- child_env(NULL) env_bind_exprs(env, foo = bar <- "bar") expect_false(env_has(get_env(), "bar")) force(env$foo) expect_true(env_has(get_env(), "bar")) env_bind_exprs(env, stop = stop("forced")) expect_error(env$stop, "forced") }) test_that("env_bind_fns() creates active bindings", { env <- env_bind_fns(env(), a = function() "foo") expect_identical(env$a, "foo") expect_identical(env$a, "foo") }) test_that("with_env() evaluates within correct environment", { fn <- function() { g(get_env()) "normal return" } g <- function(env) { with_env(env, return("early return")) } expect_equal(fn(), "early return") }) test_that("locally() evaluates within correct environment", { env <- child_env("rlang") local_env <- with_env(env, locally(get_env())) expect_identical(env_parent(local_env), env) }) test_that("ns_env() returns current namespace", { expect_identical(with_env(ns_env("rlang"), ns_env()), get_env(rlang::get_env)) }) test_that("ns_imports_env() returns imports env", { expect_identical(with_env(ns_env("rlang"), ns_imports_env()), env_parent(get_env(rlang::get_env))) }) test_that("ns_env_name() returns namespace name", { expect_identical(with_env(ns_env("base"), ns_env_name()), "base") expect_identical(ns_env_name(rlang::get_env), "rlang") }) test_that("as_environment() dispatches correctly", { expect_identical(as_environment("base"), base_env()) expect_false(env_has(as_environment(set_names(letters)), "map")) expect_identical(as_environment(NULL), empty_env()) expect_true(all(env_has(as_environment(mtcars), names(mtcars)))) expect_identical(env_parent(as_environment(mtcars)), empty_env()) expect_identical(env_parent(as_environment(mtcars, base_env())), base_env()) }) test_that("env_inherits() finds ancestor", { env <- child_env(get_env()) env <- child_env(env) expect_true(env_inherits(env, get_env())) expect_false(env_inherits(env, ns_env("utils"))) expect_true(env_inherits(empty_env(), empty_env())) }) test_that("env() creates child of current environment", { env <- env(a = 1, b = "foo") expect_identical(env_parent(env), get_env()) expect_identical(env$b, "foo") }) test_that("set_env() sets current env by default", { quo <- set_env(locally(~foo)) expect_identical(f_env(quo), get_env()) }) test_that("finds correct env type", { expect_identical(identity(env_type(ctxt_frame(2)$env)), "frame") expect_identical(env_type(global_env()), "global") expect_identical(env_type(empty_env()), "empty") expect_identical(env_type(base_env()), "base") }) test_that("get_env() fails if no default", { expect_error(get_env(list()), "Can't extract an environment from a list") }) test_that("get_env() picks up default", { dft <- env() expect_identical(get_env(list(), dft), dft) expect_identical(get_env("a", dft), dft) }) test_that("with_env() handles data", { expect_identical(with_env(mtcars, cyl), mtcars$cyl) foo <- "foo" expect_identical(with_env(mtcars, foo), "foo") }) test_that("with_env() evaluates in env", { env <- env() expect_identical(with_env(env, get_env()), env) }) test_that("env_depth() counts parents", { expect_identical(env_depth(child_env(child_env(NULL))), 2L) expect_identical(env_depth(empty_env()), 0L) }) test_that("env_parents() returns all parents", { expect_identical(env_parents(empty_env()), list2()) env1 <- child_env(NULL) env2 <- child_env(env1) expect_identical(env_parents(env2), list2(env1, empty_env())) }) test_that("scoped_envs() includes global and empty envs", { envs <- scoped_envs() expect_identical(envs[[1]], global_env()) expect_identical(envs[[length(envs)]], empty_env()) }) test_that("scoped_envs() returns named environments", { expect_identical(names(scoped_envs()), scoped_names()) }) test_that("scoped_env() deals with empty environment", { expect_identical(scoped_env("NULL"), empty_env()) }) test_that("env() doesn't partial match on env_bind()'s .env", { expect_true(all(env_has(env(.data = 1, . = 2), c(".data", ".")))) }) test_that("new_environment() creates a child of the empty env", { env <- new_environment(list(a = 1, b = 2)) expect_true(all(env_has(env, c("a", "b")))) expect_identical(env_parent(env), empty_env()) }) test_that("new_environment() accepts empty vectors", { expect_identical(length(new_environment()), 0L) expect_identical(length(new_environment(dbl())), 0L) }) test_that("env_poke() returns env", { env <- child_env(new_environment()) expect_identical(env_poke(env, "foo", "foo"), env) expect_identical(env_poke(env, "foo", "foo", inherit = TRUE), env) }) test_that("env_poke() creates binding if `create` is TRUE", { env <- new_environment() expect_identical(env_get(env_poke(env, "foo", "foo"), "foo"), "foo") expect_error(env_poke(env, "bar", "BAR", create = FALSE), "Can't find existing binding") expect_identical(env_get(env_poke(env, "foo", "FOO", create = FALSE), "foo"), "FOO") }) test_that("env_poke() inherits from parents if `inherit` is TRUE", { env <- child_env(new_environment(), foo = "foo") env <- child_env(env) env_has(env, "foo") env_has(env, "foo", TRUE) env_poke(env, "foo", "FOO", inherit = TRUE, create = FALSE) expect_identical(env_get(env_parent(env), "foo", inherit = FALSE), "FOO") expect_error(env_poke(env, "bar", "bar", inherit = TRUE, create = FALSE), "Can't find existing binding") expect_error(env_poke(env, "bar", "bar", inherit = TRUE), "Can't find existing binding") env_poke(env, "bar", "bar", inherit = TRUE, create = TRUE) expect_identical(env_get(env, "bar"), "bar") }) test_that("env_tail() detects sentinel", { sentinel <- get_env() env <- env() descendant <- child_env(child_env(child_env(env))) expect_identical(env_tail(descendant, sentinel), env) }) test_that("env_get_list() retrieves multiple bindings", { env <- env(foo = 1L, bar = 2L) expect_identical(env_get_list(env, c("foo", "bar")), list(foo = 1L, bar =2L)) baz <- 0L expect_error(env_get_list(env, "baz"), "'baz' not found") expect_identical(env_get_list(env, c("foo", "baz"), inherit = TRUE), list(foo = 1L, baz =0L)) }) test_that("scoped_bindings binds temporarily", { env <- env(foo = "foo", bar = "bar") local({ old <- scoped_bindings(.env = env, foo = "FOO", bar = "BAR", baz = "BAZ" ) expect_identical(old, list(foo = "foo", bar = "bar")) temp_bindings <- env_get_list(env, c("foo", "bar", "baz")) expect_identical(temp_bindings, list(foo = "FOO", bar = "BAR", baz = "BAZ")) }) bindings <- env_get_list(env, c("foo", "bar")) expect_identical(bindings, list(foo = "foo", bar = "bar")) expect_false(env_has(env, "baz")) }) test_that("with_bindings() evaluates with temporary bindings", { foo <- "foo" baz <- "baz" expect_identical(with_bindings(paste(foo, baz), foo = "FOO"), "FOO baz") expect_identical(foo, "foo") }) test_that("as_environment() treats named strings as vectors", { env <- as_environment(c(foo = "bar")) expect_true(is_environment(env)) expect_true(env_has(env, "foo")) }) test_that("as_environment() converts character vectors", { env <- as_environment(set_names(letters)) expect_true(is_environment(env)) expect_true(all(env_has(env, letters))) }) test_that("env_unbind() with `inherits = TRUE` wipes out all bindings", { bindings <- list(`_foo` = "foo", `_bar` = "bar") env_bind(global_env(), !!! bindings) env <- child_env(global_env(), !!! bindings) env_unbind(env, "_foo", inherit = TRUE) expect_false(all(env_has(env, names(bindings)))) expect_false(all(env_has(global_env(), names(bindings)))) }) test_that("env_bind() requires uniquely named elements", { expect_error(env_bind(env(), 1), "not uniquely named") expect_error(env_bind(env(), !!! list(1)), "not uniquely named") }) test_that("env_bind() works with empty unnamed lists", { expect_no_error(env_bind(env())) expect_no_error(env_bind(env(), !!! list())) }) test_that("env_names() unserialises unicode", { env <- env(`` = "foo") expect_identical(env_names(env), "\u5E78\u798F") }) test_that("env_clone() clones an environment", { data <- list(a = 1L, b = 2L) env <- env(!!! data) clone <- env_clone(env) expect_false(is_reference(env, clone)) expect_reference(env_parent(env), env_parent(clone)) expect_identical(env_get_list(clone, c("a", "b")), data) }) test_that("friendly_env_type() returns a friendly env name", { expect_identical(friendly_env_type("global"), "the global environment") expect_identical(friendly_env_type("empty"), "the empty environment") expect_identical(friendly_env_type("base"), "the base environment") expect_identical(friendly_env_type("frame"), "a frame environment") expect_identical(friendly_env_type("local"), "a local environment") }) test_that("is_namespace() recognises namespaces", { expect_false(is_namespace(env())) expect_true(is_namespace(get_env(is_namespace))) }) rlang/tests/testthat/helper-conditions.R0000644000176200001440000000240713241233650020132 0ustar liggesusers expect_condition <- function(expr, class = NULL, regex = NULL, info = NULL, label = NULL) { object <- tryCatch(expr, condition = identity) if (is_na(class)) { expect_false(inherits(object, "condition"), info = info, label = label) return(invisible(object)) } expect_is(object, "condition", info = info, label = label) if (!is_null(class)) { expect_is(object, class, info = info, label = label) } if (!is_null(regex)) { expect_match(object$message, regex, class, info = info, label = label) } invisible(object) } expect_no_error <- function(...) { expect_error(regexp = NA, ...) } expect_no_error_ <- function(object, ...) { expect_error(object, regexp = NA, ...) } with_verbose_retirement <- function(expr) { with_options(lifecycle_force_verbose_retirement = TRUE, expr) } with_non_verbose_retirement <- function(expr) { with_options(lifecycle_force_verbose_retirement = NULL, expr) } # This is set automatically with newer testthat versions. However it # is easier to develop rlang with the older testthat for now because # of the dangling pointers after a load_all(). options(lifecycle_force_verbose_retirement = TRUE) rlang/tests/testthat/test-c-api.R0000644000176200001440000002077413242714254016466 0ustar liggesuserscontext("C API") r_string <- function(str) { stopifnot(is_string(str)) .Call(rlang_r_string, str) } test_that("chr_prepend() prepends", { out <- .Call(rlang_test_chr_prepend, c("foo", "bar"), r_string("baz")) expect_identical(out, c("baz", "foo", "bar")) }) test_that("chr_append() appends", { out <- .Call(rlang_test_chr_append, c("foo", "bar"), r_string("baz")) expect_identical(out, c("foo", "bar", "baz")) }) test_that("r_warn() signals", { handler <- function(c) expect_null(c$call) expect_warning(regexp = "foo", with_handlers(warning = inplace(handler), .Call(rlang_test_r_warn, "foo") )) }) test_that("r_on_exit() adds deferred expr", { var <- chr() fn <- function() { .Call(rlang_test_r_on_exit, quote(var <<- c(var, "foo")), get_env()) var <<- c(var, "bar") } fn() expect_identical(var, c("bar", "foo")) }) test_that("r_is_special_op_sym() detects special operators", { is_special_op <- function(x) .Call(rlang_test_is_special_op_sym, x) expect_false(is_special_op(quote(foo))) expect_true(is_special_op(quote(`%>%`))) expect_false(is_special_op(quote(`%>>`))) expect_false(is_special_op(quote(`%%`))) }) test_that("r_base_ns_get() and r_env_get() fail if object does not exist", { expect_error(.Call(rlang_test_base_ns_get, "foobar")) }) test_that("r_current_frame() returns current frame", { current_frame <- function() { list(.Call(rlang_test_current_frame), environment()) } out <- current_frame() expect_identical(out[[1]], out[[2]]) }) test_that("r_sys_frame() returns current frame environment", { sys_frame <- function(..., .n = 0L) { list(.Call(rlang_test_sys_frame, .n), sys.frame(.n)) } out <- sys_frame(foo(), bar) expect_identical(out[[1]], out[[2]]) wrapper <- function(...) { sys_frame(.n = -1L) } out <- wrapper(foo(), bar) expect_identical(out[[1]], out[[2]]) }) test_that("r_sys_call() returns current frame call", { sys_call <- function(..., .n = 0L) { list(.Call(rlang_test_sys_call, .n), sys.call(.n)) } out <- sys_call(foo(), bar) expect_identical(out[[1]], out[[2]]) wrapper <- function(...) { sys_call(.n = -1L) } out <- wrapper(foo(), bar) expect_identical(out[[1]], out[[2]]) }) test_that("r_which_operator() returns correct tokens", { expect_identical(which_operator(quote(foo())), "") expect_identical(which_operator(""), "") expect_identical(which_operator(quote(while (a) b)), "while") expect_identical(which_operator(quote(for (a in b) b)), "for") expect_identical(which_operator(quote(repeat a)), "repeat") expect_identical(which_operator(quote(if (a) b)), "if") expect_identical(which_operator(quote(a <- b)), "<-") expect_identical(which_operator(quote(a <<- b)), "<<-") expect_identical(which_operator(quote(a < b)), "<") expect_identical(which_operator(quote(a <= b)), "<=") expect_identical(which_operator(quote(`<--`(a, b))), "") expect_identical(which_operator(quote(`<<--`(a, b))), "") expect_identical(which_operator(quote(`<==`(a, b))), "") expect_identical(which_operator(quote(a > b)), ">") expect_identical(which_operator(quote(a >= b)), ">=") expect_identical(which_operator(quote(`>-`(a, b))), "") expect_identical(which_operator(quote(`>==`(a, b))), "") expect_identical(which_operator(quote(`=`(a, b))), "=") expect_identical(which_operator(quote(a == b)), "==") expect_identical(which_operator(quote(`=-`(a, b))), "") expect_identical(which_operator(quote(`==-`(a, b))), "") expect_identical(which_operator(quote(~a)), "~unary") expect_identical(which_operator(quote(a ~ b)), "~") expect_identical(which_operator(quote(`~-`(a))), "") expect_identical(which_operator(quote(a:b)), ":") expect_identical(which_operator(quote(a::b)), "::") expect_identical(which_operator(quote(a:::b)), ":::") expect_identical(which_operator(quote(a := b)), ":=") expect_identical(which_operator(quote(`:-`(a, b))), "") expect_identical(which_operator(quote(`::-`(a, b))), "") expect_identical(which_operator(quote(`:::-`(a, b))), "") expect_identical(which_operator(quote(`:=-`(a, b))), "") expect_identical(which_operator(quote(a | b)), "|") expect_identical(which_operator(quote(a || b)), "||") expect_identical(which_operator(quote(`|-`(a, b))), "") expect_identical(which_operator(quote(`||-`(a, b))), "") expect_identical(which_operator(quote(a & b)), "&") expect_identical(which_operator(quote(a && b)), "&&") expect_identical(which_operator(quote(`&-`(a, b))), "") expect_identical(which_operator(quote(`&&-`(a, b))), "") expect_identical_(which_operator(quote(!b)), "!") expect_identical_(which_operator(quote(`!!`(b))), "!!") expect_identical_(which_operator(quote(`!!!`(b))), "!!!") expect_identical_(which_operator(quote(`!-`(a, b))), "") expect_identical_(which_operator(quote(`!!-`(a, b))), "") expect_identical_(which_operator(quote(`!!!-`(a, b))), "") expect_identical_(which_operator(quote(!?b)), "!") expect_identical_(which_operator(quote(!!?b)), "!") expect_identical(which_operator(quote(+a)), "+unary") expect_identical(which_operator(quote(a + b)), "+") expect_identical(which_operator(quote(`+-`(a))), "") expect_identical(which_operator(quote(-a)), "-unary") expect_identical(which_operator(quote(a - b)), "-") expect_identical(which_operator(quote(`--`(a))), "") expect_identical(which_operator(quote(a * b)), "*") expect_identical(which_operator(quote(a / b)), "/") expect_identical(which_operator(quote(a ^ b)), "^") expect_identical(which_operator(quote(a$b)), "$") expect_identical(which_operator(quote(a@b)), "@") expect_identical(which_operator(quote(a[b])), "[") expect_identical(which_operator(quote(a[[b]])), "[[") expect_identical(which_operator(quote(`*-`(a, b))), "") expect_identical(which_operator(quote(`/-`(a, b))), "") expect_identical(which_operator(quote(`^-`(a, b))), "") expect_identical(which_operator(quote(`$-`(a, b))), "") expect_identical(which_operator(quote(`@-`(a, b))), "") expect_identical(which_operator(quote(`[-`(a, b))), "") expect_identical(which_operator(quote(`[[-`(a, b))), "") expect_identical(which_operator(quote(a %% b)), "%%") expect_identical(which_operator(quote(a %>% b)), "special") expect_identical(which_operator(quote(`%%-`(a))), "") expect_identical(which_operator(quote((a))), "(") expect_identical(which_operator(quote({ a })), "{") expect_identical(which_operator(quote(`(-`(a))), "") expect_identical(which_operator(quote(`{-`(a))), "") }) test_that("client library passes tests", { skip_on_cran() # Silence package building and embedded tests output temp <- file() sink(temp) on.exit({ sink() close(temp) }) # tools::testInstalledPackage() can't find the package if we install # to a temporary library if (FALSE) { old_libpaths <- .libPaths() temp_lib <- tempfile("temp_lib") dir.create(temp_lib) .libPaths(c(temp_lib, old_libpaths)) on.exit(.libPaths(old_libpaths), add = TRUE) } else { temp_lib <- .libPaths() } zip_file <- normalizePath(file.path("fixtures", "lib.zip")) src_path <- normalizePath(file.path("fixtures", "rlanglibtest")) # Set temporary dir to install and test the embedded package so we # don't have to clean leftovers files temp_test_dir <- tempfile("temp_test_dir") dir.create(temp_test_dir) old <- setwd(temp_test_dir) on.exit(setwd(old), add = TRUE) file.copy(src_path, temp_test_dir, overwrite = TRUE, recursive = TRUE) pkg_path <- file.path(temp_test_dir, "rlanglibtest") # We store the library as a zip to avoid VCS noise utils::unzip(zip_file, exdir = file.path(pkg_path, "src")) # For maintenance regenerate_zip <- function() { location <- file.path("..", "..", "src") old <- setwd(location) on.exit(setwd(old)) lib_files <- c("lib.c", "lib") file.remove(zip_file) utils::zip(zip_file, lib_files) } install.packages(pkg_path, repos = NULL, type = "source", lib = temp_lib, INSTALL_opts = "--install-tests", verbose = FALSE, quiet = TRUE ) result <- tools::testInstalledPackage("rlanglibtest", lib.loc = temp_lib, types = "test") expect_identical(result, 0L) }) test_that("r_env_unbind() removes objects", { c_env_unbind <- function(env, names, inherits = FALSE) { invisible(.Call(rlang_env_unbind, env, names, inherits)) } env <- env(a = 1L) c_env_unbind(env, "a") expect_false(env_has(env, "a")) env <- env(a = 1L) child <- child_env(env) expect_warning(c_env_unbind(child, "a"), "not found") c_env_unbind(child, "a", inherits = TRUE) expect_false(env_has(env, "a")) }) rlang/tests/testthat/test-fn.R0000644000176200001440000001176513241233650016073 0ustar liggesuserscontext("function") test_that("new_function equivalent to regular function", { f1 <- function(x = a + b, y) { x + y } attr(f1, "srcref") <- NULL f2 <- new_function(alist(x = a + b, y =), quote({x + y})) expect_equal(f1, f2) }) test_that("prim_name() extracts names", { expect_equal(prim_name(c), "c") expect_equal(prim_name(prim_eval), "eval") }) test_that("as_closure() returns closure", { expect_identical(typeof(as_closure(base::list)), "closure") expect_identical(typeof(as_closure("list")), "closure") }) test_that("as_closure() handles primitive functions", { expect_identical(as_closure(`c`)(1, 3, 5), c(1, 3, 5)) expect_identical(as_closure(is.null)(1), FALSE) expect_identical(as_closure(is.null)(NULL), TRUE) eval_prim <- eval(quote(sys.function())) eval_clos <- as_closure(eval_prim) expect_identical(typeof(eval_clos), "closure") expect_identical(eval_clos(quote(data.frame), base_env()), data.frame) }) test_that("as_closure() handles operators", { expect_identical(as_closure(`-`)(.y = 10, .x = 5), -5) expect_identical(as_closure(`-`)(5), -5) expect_identical(as_closure(`$`)(mtcars, cyl), mtcars$cyl) expect_identical(as_closure(`~`)(foo), ~foo) expect_identical(as_closure(`~`)(foo, bar), foo ~ bar) expect_warning(expect_identical(as_closure(`{`)(warn("foo"), 2, 3), 3), "foo") x <- "foo" as_closure(`<-`)(x, "bar") expect_identical(x, "bar") x <- list(a = 1, b = 2) as_closure(`$<-`)(x, b, 20) expect_identical(x, list(a = 1, b = 20)) x <- list(1, 2) as_closure(`[[<-`)(x, 2, 20) expect_identical(x, list(1, 20)) x <- data.frame(x = 1:2, y = 3:4) expect_identical(as_closure(`[<-`)(x, 2, 2, 10L), 10L) expect_identical(x, data.frame(x = 1:2, y = c(3L, 10L))) expect_error(as_closure(`[<-`)(), "Must supply operands") methods::setClass("rlang_test", methods::representation(foo = "character")) s4 <- methods::new("rlang_test") as_closure(`@<-`)(s4, "foo", "FOO") expect_identical(s4@foo, "FOO") x <- list(1, 2) expect_identical(as_closure(`[[<-`)(x, 2, 20), 20) expect_identical(x, list(1, 20)) x <- list2(list2(a = "A"), list2(a = "B")) expect_identical(lapply(x, as_closure(`[[`), "a"), list("A", "B")) }) test_that("lambda shortcut handles positional arguments", { expect_identical(as_function(~ ..1 + ..3)(1, 2, 3), 4) }) test_that("lambda shortcut fails with two-sided formulas", { expect_error(as_function(lhs ~ ..1 + ..3), "two-sided formula") }) test_that("as_function() handles strings", { expect_identical(as_function("mean"), mean) env <- env(fn = function() NULL) expect_identical(as_function("fn", env), env$fn) }) test_that("fn_fmls_syms() unnames `...`", { expect_identical(fn_fmls_syms(lapply), list(X = quote(X), FUN = quote(FUN), quote(...))) }) test_that("fn_fmls_syms() works with functions of zero arguments", { expect_identical(fn_fmls_syms(function() NULL), list()) }) test_that("as_closure() gives informative error messages on control flow primitives (#158)", { expect_error(as_closure(`if`), "Can't coerce the primitive function `if`") }) test_that("fn_fmls<- and fn_fmls_names<- change formals", { fn <- function() NULL fn_fmls(fn) <- list(a = 1) expect_identical(fn_fmls(fn), pairlist(a = 1)) fn_fmls_names(fn) <- c("b") expect_identical(fn_fmls(fn), pairlist(b = 1)) }) test_that("fn_fmls<- and fn_fmls_names<- handle primitive functions", { fn_fmls(`+`) <- list(a = 1, b = 2) expect_true(is_closure(`+`)) expect_identical(fn_fmls(`+`), pairlist(a = 1, b = 2)) fn_fmls_names(`+`) <- c("A", "B") expect_identical(fn_fmls(`+`), pairlist(A = 1, B = 2)) }) test_that("assignment methods preserve attributes", { orig <- set_attrs(function(foo) NULL, foo = "foo", bar = "bar") fn <- orig fn_fmls(fn) <- list(arg = 1) expect_identical(attributes(fn), attributes(orig)) fn <- orig fn_fmls_names(fn) <- "bar" expect_identical(attributes(fn), attributes(orig)) fn <- orig fn_body(fn) <- "body" orig_attrs <- attributes(orig) orig_attrs$srcref <- NULL expect_identical(attributes(fn), orig_attrs) }) test_that("print method for `fn` discards attributes", { fn <- set_attrs(function() NULL, foo = "foo") fn <- new_fn(fn) temp <- file() sink(temp) on.exit({ sink() close(temp) }) print(fn) output <- paste0(readLines(temp, warn = FALSE), collapse = "\n") expect_false(grepl("attr", output)) }) test_that("fn_body() requires a closure to extract body", { expect_error(fn_body(c), "`fn` is not a closure") expect_null(fn_body(function() NULL)) }) test_that("fn_env() requires a function to extract env", { expect_error(fn_env(1L), "`fn` is not a function") expect_identical(fn_env(function() NULL), get_env()) }) test_that("`fn_env<-`() sets environment", { fn <- function() NULL fn_env(fn) <- base_env() expect_reference(fn_env(fn), base_env()) }) test_that("primitive predicates work", { expect_true(is_primitive_eager(c)) expect_true(is_primitive_lazy(`$`)) expect_false(is_primitive_eager(`$`)) expect_false(is_primitive_lazy(`c`)) }) rlang/tests/testthat/test-state.R0000644000176200001440000000102313241233650016572 0ustar liggesuserscontext("state") test_that("can't add an exit event at top-level", { expect_error(scoped_exit(1, global_env()), "Can't add an exit event at top-level") }) test_that("options are set temporarily", { scoped_options(foo = "foo") expect_identical(with_options(foo = "bar", peek_option("foo")), "bar") expect_identical(peek_option("foo"), "foo") }) test_that("peek_options() returns a named list", { scoped_options(foo = "FOO", bar = "BAR") expect_identical(peek_options("foo", "bar"), list(foo = "FOO", bar = "BAR")) }) rlang/tests/testthat/test-retired.R0000644000176200001440000001015713241233650017120 0ustar liggesuserscontext("retired") test_that("parse_quosure() forwards to parse_quo()", { env <- env() expect_warning(expect_identical(parse_quosure("foo", env), parse_quo("foo", env)), "soft-deprecated") expect_warning(expect_identical(parse_quosures("foo; bar", env), parse_quos("foo; bar", env)), "soft-deprecated") }) test_that("quo_expr() forwards to quo_squash()", { quo <- quo(list(!!quo(foo))) expect_identical(quo_expr(quo), quo_squash(quo)) }) test_that("lang() forwards to call2() and is_lang() to is_call()", { lang <- lang("foo", !!! list(1, 2), .ns = "bar") call <- call2("foo", !!! list(1, 2), .ns = "bar") expect_identical(lang, call) expect_true(is_lang(lang, "foo", 2, "bar")) expect_false(is_unary_lang(lang, "foo", "bar")) expect_true(is_binary_lang(lang, "foo", "bar")) }) test_that("new_language() forwards to new_call()", { expect_identical( new_language(quote(foo), pairlist("bar")), new_call(quote(foo), pairlist("bar")) ) }) test_that("lang_modify() forwards to call_modify()", { fn <- function(foo = "bar") NULL call <- quote(fn(f = "foo")) expect_identical( lang_modify(call, baz = "bam", .standardise = TRUE), call_modify(call, baz = "bam", .standardise = TRUE) ) }) test_that("lang_standardise() forwards to call_standardise()", { fn <- function(foo = "bar") NULL call <- quote(fn(f = "foo")) expect_identical( lang_standardise(call), call_standardise(call) ) }) test_that("`lang_` accessors forward to `call_` accessors", { fn <- function(foo = "bar") NULL call <- quote(fn(f = "foo")) expect_identical(lang_fn(call), fn) expect_identical(lang_name(call), "fn") expect_identical(lang_args(call), list(f = "foo")) expect_identical(lang_args_names(call), "f") }) test_that("lang_tail() still works", { expect_identical( pairlist(sym("a")), lang_tail(expr(foo(a))) ) }) test_that("lang_head() still works", { expect_identical( lang_head(expr(foo(a))), expr(foo) ) }) test_that("as_overscope() forwards to as_data_mask()", { quo <- quo(foo) expect_equal(as_overscope(quo, mtcars), as_data_mask(mtcars, quo_get_env(quo))) }) test_that("overscope functions forward to mask functions", { top <- env() bottom <- child_env(top, foo = "bar") mask <- new_overscope(bottom, top) expect_true(env_has(mask, ".__tidyeval_data_mask__.")) expect_identical(eval_tidy_(quote(foo), bottom, top), "bar") overscope_clean(mask) expect_false(env_has(env_parent(mask), "foo")) mask <- as_data_mask(mtcars) x <- 10 expect_identical(overscope_eval_next(mask, quote(cyl * x), get_env()), mtcars$cyl * x) expect_identical(overscope_eval_next(mask, quote(am * x), get_env()), mtcars$am * x) }) test_that("as_dictionary() forwards to as_data_pronoun()", { dict <- as_dictionary(mtcars, "Column `%s` not found in `.data`", TRUE) expect_identical(dict, as_data_pronoun(mtcars)) dict <- as_dictionary(list2env(mtcars), "Column `%s` not found in `.data`", TRUE) expect_equal(dict, as_data_pronoun(list2env(mtcars))) expect_true(is_dictionary(dict)) }) test_that("as_env() forwards to as_environment()", { x <- as_env(mtcars, base_env()) y <- as_environment(mtcars, base_env()) expect_equal(x, y) expect_identical(env_parent(x), env_parent(y)) }) test_that("is_expr() forwards to is_expression()", { expect_true(is_expr(1L)) expect_false(is_expr(1:2)) }) test_that("is_quosureish() and as_quosureish() still work", { expect_warning(expect_true(is_quosureish(~foo)), "deprecated") expect_warning(expect_false(is_quosureish(~foo, scoped = FALSE)), "deprecated") expect_warning(expect_identical(as_quosureish(quote(foo)), quo(foo)), "deprecated") }) test_that("new_cnd() and cnd_ functions forward to cnd() and _cnd functions()", { expect_warning(expect_identical(new_cnd("foo"), cnd("foo")), "renamed") expect_warning(expect_identical(cnd_warning("foo"), warning_cnd("foo")), "renamed") expect_warning(expect_identical(cnd_error("foo"), error_cnd("foo")), "renamed") expect_warning(expect_identical(cnd_message("foo"), message_cnd("foo")), "renamed") }) test_that("node() still works", { expect_identical(node(1, NULL), new_node(1, NULL)) }) rlang/tests/testthat/test-attr.R0000644000176200001440000000334413241233650016434 0ustar liggesuserscontext("attributes") test_that("names2() takes care of missing values", { x <- set_names(1:3, c("a", NA, "b")) expect_identical(names2(x), c("a", "", "b")) }) test_that("names2() fails for environments", { expect_error(names2(env()), "Use env_names() for environments.", fixed = TRUE) }) test_that("set_attrs() fails with uncopyable types", { expect_error(set_attrs(env(), foo = "bar"), "is uncopyable") }) test_that("mut_attrs() fails with copyable types", { expect_error(mut_attrs(letters, foo = "bar"), "is copyable") }) test_that("set_attrs() called with NULL zaps attributes", { obj <- set_attrs(letters, foo = "bar") expect_identical(set_attrs(obj, NULL), letters) }) test_that("set_attrs() does not zap old attributes", { obj <- set_attrs(letters, foo = "bar") obj <- set_attrs(obj, baz = "bam") expect_named(attributes(obj), c("foo", "baz")) }) test_that("inputs must be valid", { expect_error(set_names(environment()), "must be a vector") expect_error(set_names(1:10, letters[1:4]), "same length") }) test_that("can supply vector or ...", { expect_named(set_names(1:2, c("a", "b")), c("a", "b")) expect_named(set_names(1:2, "a", "b"), c("a", "b")) expect_named(set_names(1:2, 1, 2), c("1", "2")) }) test_that("can supply function/formula to rename", { x <- c(a = 1, b = 2) expect_named(set_names(x, toupper), c("A", "B")) expect_named(set_names(x, ~ toupper(.)), c("A", "B")) expect_named(set_names(x, paste, "foo"), c("a foo", "b foo")) }) test_that("set_names() zaps names", { expect_null(names(set_names(mtcars, NULL))) }) test_that("set_names() coerces to character", { expect_identical(set_names(1L, TRUE), c(`TRUE` = 1L)) expect_identical(set_names(1:2, "a", TRUE), c(a = 1L, `TRUE` = 2L)) }) rlang/tests/testthat/test-compat.R0000644000176200001440000000562613241233650016752 0ustar liggesuserscontext("compat") test_that("names() dispatches on environment", { env <- child_env(NULL, foo = "foo", bar = "bar") expect_identical(sort(names(env)), c("bar", "foo")) }) test_that("lazy objects are converted to tidy quotes", { env <- child_env(get_env()) lazy <- structure(list(expr = quote(foo(bar)), env = env), class = "lazy") expect_identical(compat_lazy(lazy), new_quosure(quote(foo(bar)), env)) lazy_str <- "foo(bar)" expect_identical(compat_lazy(lazy_str), quo(foo(bar))) lazy_lang <- quote(foo(bar)) expect_identical(compat_lazy(lazy_lang), quo(foo(bar))) lazy_sym <- quote(foo) expect_identical(compat_lazy(lazy_sym), quo(foo)) }) test_that("lazy_dots objects are converted to tidy quotes", { env <- child_env(get_env()) lazy_dots <- structure(class = "lazy_dots", list( lazy = structure(list(expr = quote(foo(bar)), env = env), class = "lazy"), lazy_lang = quote(foo(bar)) )) expected <- list( lazy = new_quosure(quote(foo(bar)), env), lazy_lang = quo(foo(bar)), quo(foo(bar)) ) expect_identical(compat_lazy_dots(lazy_dots, get_env(), "foo(bar)"), expected) }) test_that("unnamed lazy_dots are given default names", { lazy_dots <- structure(class = "lazy_dots", list( "foo(baz)", quote(foo(bar)) )) expected <- list( `foo(baz)` = quo(foo(baz)), `foo(bar)` = quo(foo(bar)), foobarbaz = quo(foo(barbaz)) ) dots <- compat_lazy_dots(lazy_dots, get_env(), foobarbaz = "foo(barbaz)", .named = TRUE) expect_identical(dots, expected) }) test_that("compat_lazy() handles missing arguments", { expect_identical(compat_lazy(), quo()) }) test_that("compat_lazy_dots() takes lazy objects", { lazy <- set_attrs(list(expr = quote(foo), env = empty_env()), class = "lazy") expect_identical(compat_lazy_dots(lazy), named_list(new_quosure(quote(foo), empty_env()))) }) test_that("compat_lazy_dots() takes symbolic objects", { expect_identical(compat_lazy_dots(quote(foo), empty_env()), named_list(new_quosure(quote(foo), empty_env()))) expect_identical(compat_lazy_dots(quote(foo(bar)), empty_env()), named_list(new_quosure(quote(foo(bar)), empty_env()))) }) test_that("compat_lazy() demotes character vectors to strings", { expect_identical(compat_lazy_dots(NULL, get_env(), c("foo", "bar")), named_list(as_quosure(~foo))) }) test_that("compat_lazy() handles numeric vectors", { expect_identical(compat_lazy_dots(NULL, get_env(), NA_real_), named_list(set_env(quo(NA_real_)))) expect_warning(expect_identical(compat_lazy_dots(NULL, get_env(), 1:3), named_list(set_env(quo(1L)))), "Truncating vector") }) test_that("compat_lazy() handles bare formulas", { expect_identical(compat_lazy(~foo), quo(foo)) expect_identical(compat_lazy_dots(~foo), named_list(quo(foo))) }) test_that("trimws() trims", { x <- " foo. " expect_identical(trimws(x), "foo.") expect_identical(trimws(x, "l"), "foo. ") expect_identical(trimws(x, "r"), " foo.") }) rlang/tests/testthat/test-s3.R0000644000176200001440000000443613241233650016012 0ustar liggesuserscontext("s3") test_that("inherits from all classes", { x <- structure(list(), class = c("foo", "bar", "baz")) expect_true(inherits_all(x, c("foo"))) expect_true(inherits_all(x, c("foo", "baz"))) expect_true(inherits_all(x, c("foo", "bar", "baz"))) expect_false(inherits_all(x, c("fooz"))) expect_false(inherits_all(x, c("foo", "barz", "baz"))) expect_false(inherits_all(x, c("fooz", "bar", "baz"))) expect_error(inherits_all(x, chr()), "empty") }) test_that("inherits from any class", { x <- structure(list(), class = "bar") expect_true(inherits_any(x, c("bar", "foo"))) expect_true(inherits_any(x, c("foo", "bar"))) expect_true(inherits_any(x, c("foo", "bar", "baz"))) expect_false(inherits_any(x, c("foo", "baz"))) expect_error(inherits_any(x, chr()), "empty") }) test_that("inherits only from class", { x <- structure(list(), class = c("foo", "bar", "baz")) expect_false(inherits_only(x, c("foo", "baz"))) expect_true(inherits_only(x, c("foo", "bar", "baz"))) }) test_that("can box and unbox a value", { box <- new_box(letters, "foo") expect_true(is_box(box)) expect_true(is_box(box), "foo") expect_false(is_box(box, "bar")) expect_identical(unbox(box), letters) box <- new_box(NULL, c("foo", "bar", "baz")) expect_true(is_box(box, c("foo", "baz"))) expect_false(is_box(box, c("baz", "foo"))) }) test_that("as_box() ensures boxed value", { box <- as_box(NULL) expect_true(inherits_only(box, "rlang_box")) boxbox <- as_box(box) expect_true(inherits_only(box, "rlang_box")) expect_null(unbox(box)) some_box <- as_box(NULL, "some_box") some_boxbox <- as_box(some_box, "other_box") expect_true(inherits_only(some_boxbox, c("other_box", "rlang_box"))) expect_true(inherits_only(unbox(some_boxbox), c("some_box", "rlang_box"))) expect_null(unbox(unbox(some_boxbox))) }) test_that("as_box_if() ensures boxed value if predicate returns TRUE", { box <- as_box_if(NULL, is_null, "null_box") expect_true(inherits_only(box, c("null_box", "rlang_box"))) boxbox <- as_box_if(box, is_null, "null_box") expect_true(inherits_only(box, c("null_box", "rlang_box"))) expect_null(unbox(boxbox)) expect_null(as_box_if(NULL, is_vector, "null_box")) }) test_that("unboxing a non-boxed value is an error", { expect_error(unbox(NULL), "must be a box") }) rlang/tests/testthat/helper-print.R0000644000176200001440000000014313241233650017110 0ustar liggesusers expect_fixed_output <- function(object, output) { expect_output(object, output, fixed = TRUE) } rlang/tests/testthat/test-eval-tidy.R0000644000176200001440000002043313241233650017356 0ustar liggesuserscontext("eval-tidy") test_that("accepts expressions", { expect_identical(eval_tidy(10), 10) expect_identical(eval_tidy(quote(letters)), letters) }) test_that("eval_tidy uses quosure environment", { x <- 10 quo <- local({ y <- 100 quo(x + y) }) expect_equal(eval_tidy(quo), 110) }) test_that("data must be uniquely named", { expect_error(eval_tidy(NULL, list(x = 1, x = 2)), "has duplicate elements") data <- set_names(data.frame(x = 1, x = 2, y = 3, y = 4), c("x", "x", "y", "y")) expect_error(eval_tidy(NULL, data), "has duplicate elements") }) test_that("can supply unnamed empty data", { expect_identical(eval_tidy("foo", list()), "foo") expect_identical(eval_tidy("foo", data.frame()), "foo") }) test_that("looks first in `data`", { x <- 10 data <- list(x = 100) expect_equal(eval_tidy(quo(x), data), 100) }) test_that("pronouns resolve ambiguity looks first in `data`", { x <- 10 data <- list(x = 100) expect_equal(eval_tidy(quo(.data$x), data), 100) expect_equal(eval_tidy(quo(.env$x), data), 10) }) test_that("pronouns complain about missing values", { expect_error(eval_tidy(quo(.data$x), list()), "Column `x` not found in `.data`") expect_error(eval_tidy(quo(.data$x), data.frame()), "Column `x` not found in `.data`") }) test_that("nested quosures look in their own env", { n <- 10 f <- function() { n <- 100 quo(n) } quo <- quo(!!f()) expect_equal(eval_tidy(quo), 100) }) test_that("nested quosure thunks rechain properly in the non-data mask", { bar <- "foo" quo <- quo(identity(!!quo(toupper(!!quo(identity(bar)))))) expect_identical(eval_tidy(quo), "FOO") }) test_that("unquoted formulas can use data", { f1 <- function() { z <- 100 x <- 2 quo(x + z) } f2 <- function() { z <- 100 quo(.data$x + .env$z) } z <- 10 expect_identical(eval_tidy(f2(), list(x = 1)), 101) expect_identical(eval_tidy(quo(!! f1()), data = list(x = 1)), 101) expect_identical(eval_tidy(quo(!! f2()), data = list(x = 1)), 101) }) test_that("bare formulas are not evaluated", { f <- local(~x) expect_identical(eval_tidy(quo(!! f)), f) f <- a ~ b expect_identical(eval_tidy(quo(!! f)), f) }) test_that("quosures are not evaluated if not forced", { fn <- function(arg, force) { if (force) arg else "bar" } f1 <- quo(fn(!! quo(stop("forced!")), force = FALSE)) f2 <- quo(fn(!! local(quo(stop("forced!"))), force = FALSE)) expect_identical(eval_tidy(f1), "bar") expect_identical(eval_tidy(f2), "bar") f_forced1 <- quo(fn(!! quo(stop("forced!")), force = TRUE)) f_forced2 <- quo(fn(!! local(quo(stop("forced!"))), force = TRUE)) expect_error(eval_tidy(f_forced1), "forced!") expect_error(eval_tidy(f_forced2), "forced!") }) test_that("can unquote captured arguments", { var <- quo(cyl) fn <- function(arg) eval_tidy(enquo(arg), mtcars) expect_identical(fn(var), quo(cyl)) expect_identical(fn(!!var), mtcars$cyl) }) test_that("quosures are evaluated recursively", { foo <- "bar" expect_identical(eval_tidy(quo(foo)), "bar") expect_identical(eval_tidy(quo(!!quo(!! quo(foo)))), "bar") }) test_that("quosures have lazy semantics", { fn <- function(arg) "unforced" expect_identical(eval_tidy(quo(fn(~stop()))), "unforced") }) test_that("can unquote hygienically within captured arg", { fn <- function(df, arg) eval_tidy(enquo(arg), df) foo <- "bar"; var <- quo(foo) expect_identical(fn(mtcars, list(var, !!var)), list(quo(foo), "bar")) var <- quo(cyl) expect_identical(fn(mtcars, (!!var) > 4), mtcars$cyl > 4) expect_identical(fn(mtcars, list(var, !!var)), list(quo(cyl), mtcars$cyl)) expect_equal(fn(mtcars, list(~var, !!var)), list(~var, mtcars$cyl)) expect_equal(fn(mtcars, list(~~var, !!quo(var), !!quo(quo(var)))), list(~~var, quo(cyl), quo(var))) }) test_that("can unquote for old-style NSE functions", { var <- quo(foo) fn <- function(x) substitute(x) expect_identical(quo(fn(!!quo_get_expr(var))), quo(fn(foo))) expect_identical(eval_tidy(quo(fn(!!quo_get_expr(var)))), quote(foo)) }) test_that("all quosures in the call are evaluated", { foobar <- function(x) paste0("foo", x) x <- new_quosure(call("foobar", local({ bar <- "bar"; quo(bar) }))) f <- new_quosure(call("identity", x)) expect_identical(eval_tidy(f), "foobar") }) test_that("two-sided formulas are not treated as quosures", { expect_identical(eval_tidy(new_quosure(a ~ b)), a ~ b) }) test_that("formulas are evaluated in evaluation environment", { f <- eval_tidy(quo(foo ~ bar), list(foo = "bar")) expect_false(identical(f_env(f), get_env())) }) test_that("evaluation env is cleaned up", { f <- local(quo(function() list(f = ~letters, env = environment()))) fn <- eval_tidy(f) out <- fn() expect_identical(out$f, with_env(env = out$env, ~letters)) }) test_that("inner formulas are rechained to evaluation env", { env <- child_env(NULL) f1 <- quo(env$eval_env1 <- get_env()) f2 <- quo({ !! f1 env$eval_env2 <- get_env() }) eval_tidy(f2, mtcars) expect_identical(env$eval_env1, env$eval_env2) expect_true(env_inherits(env$eval_env2, get_env(f2))) }) test_that("dyn scope is chained to lexical env", { foo <- "bar" overscope <- child_env(NULL) expect_identical(eval_tidy_(quo(foo), overscope), "bar") }) test_that("whole scope is purged", { outside <- child_env(NULL, important = TRUE) top <- child_env(outside, foo = "bar", hunoz = 1) mid <- child_env(top, bar = "baz", hunoz = 2) data_mask_objects <- list( .top_env = top, .env = 1, `~` = 2, .__tidyeval_data_mask__. = env() ) bottom <- child_env(mid, !!! data_mask_objects) overscope_clean(bottom) expect_identical(names(bottom), character(0)) expect_identical(names(mid), character(0)) expect_identical(names(top), character(0)) expect_identical(names(outside), "important") }) test_that("empty quosure self-evaluates", { quo <- quo(is_missing(!! quo())) expect_true(eval_tidy(quo)) }) test_that("cannot replace elements of pronouns", { expect_error(eval_tidy(quo(.data$foo <- "bar")), "Can't modify the data pronoun") }) test_that("formulas are not evaluated as quosures", { expect_identical(eval_tidy(~letters), ~letters) }) test_that("can supply environment as data", { `_x` <- "foo" expect_identical(eval_tidy(quo(`_x`), environment()), "foo") expect_error(eval_tidy(quo(`_y`), environment()), "not found") }) test_that("tilde calls are evaluated in overscope", { quo <- quo({ foo <- "foo" ~foo }) f <- eval_tidy(quo) expect_true(env_has(f, "foo")) }) test_that(".env pronoun refers to current quosure (#174)", { inner_quo <- local({ var <- "inner" quo(.env$var) }) outer_quo <- local({ var <- "outer" quo(identity(!! inner_quo)) }) expect_identical(eval_tidy(outer_quo, list()), "inner") }) test_that("can call tilde with named arguments (#226)", { expect_equal(eval_tidy(quote(`~`(foo = x, bar = y))), x ~ y) expect_equal(eval_tidy(quote(`~`(foo = x, bar = y, baz = z))), `~`(foo = x, bar = y, baz = z)) }) test_that("Arguments to formulas are not stripped from their attributes (#227)", { quo <- quo(x) f <- eval_tidy(quo(~!!quo)) expect_identical(f_rhs(f), quo) f <- eval_tidy(quo(!!quo(x) ~ a)) expect_identical(f_lhs(f), quo) }) test_that("tilde thunks are unique", { new_tilde_thunk <- function(data_mask, data_mask_top) { .Call(rlang_new_tilde_thunk, data_mask, data_mask_top) } thunk1 <- new_tilde_thunk(1, 2) thunk2 <- new_tilde_thunk(1, 2) expect_false(is_reference(thunk1, thunk2)) body1 <- body(thunk1) body2 <- body(thunk2) expect_false(is_reference(body1, body2)) }) test_that("evaluating an empty quosure fails", { expect_error(eval_tidy(quo()), "not found") }) test_that("can supply a data mask as data", { mask <- as_data_mask(list(x = 1L)) eval_tidy(quo(x <- 2L), mask) expect_identical(eval_tidy(quo(x), mask), 2L) }) test_that("as_data_pronoun() creates pronoun", { data <- as_data_pronoun(mtcars) expect_is(data, "rlang_data_pronoun") expect_error(data$foobar, "Column `foobar` not found in `.data`") expect_identical(data[["cyl"]], mtcars$cyl) }) test_that("pronoun has print() and str() method", { data <- as_data_pronoun(mtcars) expect_output(print(data), "\n11 objects") expect_output(str(data), "32 obs") data <- as_data_pronoun(list(a = 1)) expect_output(print(data), "\n1 object") }) rlang/src/0000755000176200001440000000000013242736425012154 5ustar liggesusersrlang/src/Makevars0000644000176200001440000000211013242736425013642 0ustar liggesusersPKG_CPPFLAGS = -I./lib/ lib-files = \ lib/rlang.h \ lib/attrs.c \ lib/cnd.c \ lib/env.c \ lib/eval.c \ lib/export.c \ lib/fn.c \ lib/formula.c \ lib/lang.c \ lib/node.c \ lib/parse.c \ lib/quo.c \ lib/replace-na.c \ lib/rlang.c \ lib/sexp.c \ lib/squash.c \ lib/stack.c \ lib/sym.c \ lib/sym-unescape.c \ lib/vec.c \ lib/vec-chr.c \ lib/vec-lgl.c \ lib/vec-list.c internal-files = \ internal/arg.c \ internal/dots.c \ internal/eval-tidy.c \ internal/expr-interp.c \ internal/expr-interp-rotate.c \ internal/internal.c \ internal/quo.c \ internal/utils.c export-files = \ export/exported.c \ export/exported-tests.c \ export/init.c all: $(SHLIB) $(SHLIB): lib.c internal.c export.c lib.c: $(lib-files) touch lib.c internal.c: $(internal-files) touch internal.c export.c: $(export-files) touch export.c .PHONY: all rlang/src/lib/0000755000176200001440000000000013242771563012724 5ustar liggesusersrlang/src/lib/squash.h0000644000176200001440000000032013242736425014372 0ustar liggesusers#ifndef RLANG_SQUASH_H #define RLANG_SQUASH_H bool r_is_spliced(sexp* x); bool r_is_spliced_bare(sexp* x); sexp* r_squash_if(sexp* dots, enum r_type kind, bool (*is_spliceable)(sexp*), int depth); #endif rlang/src/lib/env.h0000644000176200001440000000305713242736425013670 0ustar liggesusers#ifndef RLANG_ENV_H #define RLANG_ENV_H #include #include #define r_global_env R_GlobalEnv #define r_base_env R_BaseEnv #define r_empty_env R_EmptyEnv #if (!defined(R_VERSION) || R_VERSION < R_Version(3, 2, 0)) static inline sexp* r_env_names(sexp* env) { return R_lsInternal(env, true); } #else static inline sexp* r_env_names(sexp* env) { return R_lsInternal3(env, true, false); } #endif static inline sexp* r_env_parent(sexp* env) { return ENCLOS(env); } static inline void r_env_poke_parent(sexp* env, sexp* new_parent) { SET_ENCLOS(env, new_parent); } static inline bool r_is_environment(sexp* x) { return TYPEOF(x) == ENVSXP; } // TODO A more complete family that optionally looks up ancestry // The `find` variant does not fail if object does not exist static inline sexp* r_env_find(sexp* env, sexp* sym) { return Rf_findVarInFrame3(env, sym, TRUE); } static inline sexp* r_env_get(sexp* env, sexp* sym) { return Rf_eval(sym, env); } static inline sexp* r_env_poke(sexp* env, sexp* sym, sexp* value) { Rf_defineVar(sym, value, env); return env; } sexp* r_ns_env(const char* pkg); sexp* r_base_ns_get(const char* name); sexp* r_new_environment(sexp* parent, r_ssize_t size); sexp* r_env_as_list(sexp* x); sexp* r_list_as_environment(sexp* x, sexp* parent); sexp* r_env_clone(sexp* env, sexp* parent); sexp* r_env_unbind_names(sexp* env, sexp* names, bool inherits); sexp* r_env_unbind_all(sexp* env, const char** names, r_ssize_t n, bool inherits); sexp* r_env_unbind(sexp* env, const char* name, bool inherits); #endif rlang/src/lib/vec-chr.c0000644000176200001440000000252713242736425014423 0ustar liggesusers#include #include "rlang.h" sexp* r_new_character(const char** strings, int n) { sexp* out = KEEP(r_new_vector(STRSXP, n)); for (int i = 0; i < n; ++i) { r_chr_poke(out, i, r_string(strings[i])); } FREE(1); return out; } bool r_chr_has(sexp* chr, const char* c_string) { sexp* nm; for (int i = 0; i != r_vec_length(chr); ++i) { nm = STRING_ELT(chr, i); if (strcmp(CHAR(nm), c_string) == 0) { return true; } } return false; } static void validate_chr_setter(sexp* chr, sexp* r_string) { if (!r_is_character(chr)) { r_abort("`chr` must be a character vector"); } if (!r_is_r_string(r_string)) { r_abort("`r_string` must be an internal R string"); } } sexp* chr_prepend(sexp* chr, sexp* r_string) { if (r_is_null(chr)) { return Rf_ScalarString(r_string); } else { validate_chr_setter(chr, r_string); } int n = r_length(chr); sexp* out = KEEP(r_new_vector(STRSXP, n + 1)); r_vec_poke_n(out, 1, chr, 0, n); r_chr_poke(out, 0, r_string); FREE(1); return out; } sexp* chr_append(sexp* chr, sexp* r_str) { if (r_is_null(chr)) { return Rf_ScalarString(r_str); } validate_chr_setter(chr, r_str); int n = r_length(chr); sexp* out = KEEP(r_new_vector(STRSXP, n + 1)); r_vec_poke_n(out, 0, chr, 0, n); r_chr_poke(out, n, r_str); FREE(1); return out; } rlang/src/lib/rlang.h0000644000176200001440000000331613242736425014201 0ustar liggesusers#ifndef RLANG_RLANG_H #define RLANG_RLANG_H #include #include #define R_NO_REMAP #include typedef struct SEXPREC sexp; typedef Rbyte r_byte_t; typedef Rcomplex r_complex_t; typedef R_len_t r_ssize_t; typedef R_xlen_t r_long_ssize_t; #define R_SSIZE_MAX R_LEN_T_MAX enum r_type { r_type_null = 0, r_type_symbol = 1, r_type_pairlist = 2, r_type_closure = 3, r_type_environment = 4, r_type_promise = 5, r_type_call = 6, r_type_special = 7, r_type_builtin = 8, r_type_string = 9, r_type_logical = 10, r_type_integer = 13, r_type_double = 14, r_type_complex = 15, r_type_character = 16, r_type_dots = 17, r_type_any = 18, r_type_list = 19, r_type_expression = 20, r_type_bytecode = 21, r_type_pointer = 22, r_type_weakref = 23, r_type_raw = 24, r_type_s4 = 25, r_type_new = 30, r_type_free = 31, r_type_function = 99 }; #define r_null R_NilValue #define KEEP PROTECT #define FREE UNPROTECT #define KEEP_N(x, n) (++n, KEEP(x)) #define KEEP_WITH_INDEX(x, i) PROTECT_WITH_INDEX(x, &i) #define KEEP_I REPROTECT #define RLANG_ASSERT(condition) ((void)sizeof(char[1 - 2*!(condition)])) #include "sexp.h" #include "attrs.h" #include "debug.h" #include "cnd.h" #include "env.h" #include "eval.h" #include "export.h" #include "fn.h" #include "formula.h" #include "lang.h" #include "node.h" #include "parse.h" #include "quo.h" #include "squash.h" #include "stack.h" #include "state.h" #include "sym.h" #include "vec.h" #include "vec-chr.h" #include "vec-lgl.h" #include "vec-list.h" void r_init_library(); #endif rlang/src/lib/formula.c0000644000176200001440000000356713242736425014546 0ustar liggesusers#include "rlang.h" sexp* r_f_rhs(sexp* f) { if (r_typeof(f) != LANGSXP) { r_abort("`x` must be a formula"); } switch (r_length(f)) { case 2: return r_node_cadr(f); case 3: return CADDR(f); default: r_abort("Invalid formula"); } } sexp* r_f_lhs(sexp* f) { if (r_typeof(f) != LANGSXP) { r_abort("`x` must be a formula"); } switch (r_length(f)) { case 2: return r_null; case 3: return r_node_cadr(f); default: r_abort("Invalid formula"); } } sexp* r_f_env(sexp* f) { return r_get_attribute(f, r_sym(".Environment")); } bool r_f_has_env(sexp* f) { return r_is_environment(r_f_env(f)); } bool r_is_formulaish(sexp* x, int scoped, int lhs) { static const char* formulaish_names[2] = { "~", ":=" }; if (r_typeof(x) != LANGSXP) { return false; } sexp* head = r_node_car(x); if (!r_is_symbol_any(head, formulaish_names, 2)) { return false; } if (scoped >= 0) { int has_env = r_typeof(r_f_env(x)) == ENVSXP; if (scoped != has_env) { return false; } } if (lhs >= 0) { int has_lhs = r_length(x) > 2; if (lhs != has_lhs) { return false; } } return true; } sexp* new_raw_formula(sexp* lhs, sexp* rhs, sexp* env) { static sexp* tilde_sym = NULL; if (!tilde_sym) { tilde_sym = r_sym("~"); } if (!r_is_environment(env) && env != r_null) { r_abort("`env` must be an environment"); } sexp* f; sexp* args; if (lhs == r_null) { args = KEEP(r_new_node_list(rhs)); } else { args = KEEP(r_new_node_list2(lhs, rhs)); } f = KEEP(r_new_call_node(tilde_sym, args)); sexp* attrs = KEEP(r_new_node(env, r_null)); r_node_poke_tag(attrs, r_sym(".Environment")); r_poke_attributes(f, attrs); FREE(3); return f; } sexp* r_new_formula(sexp* lhs, sexp* rhs, sexp* env) { sexp* f = KEEP(new_raw_formula(lhs, rhs, env)); r_push_class(f, "formula"); FREE(1); return f; } rlang/src/lib/vec-list.c0000644000176200001440000000050613242736425014615 0ustar liggesusers#include "rlang.h" sexp* r_new_list(sexp* x, const char* name) { sexp* out = KEEP(r_new_vector(r_type_list, 1)); r_list_poke(out, 0, x); if (name) { sexp* nms = KEEP(r_new_vector(r_type_character, 1)); r_push_names(x, nms); r_chr_poke(nms, 0, r_string(name)); FREE(1); } FREE(1); return out; } rlang/src/lib/vec-chr.h0000644000176200001440000000425213242736425014425 0ustar liggesusers#ifndef RLANG_VECTOR_CHR_H #define RLANG_VECTOR_CHR_H #include #define r_missing_str R_NaString static inline bool r_is_character(sexp* x) { return r_typeof(x) == STRSXP; } static inline sexp* r_chr_get(sexp* chr, r_ssize_t i) { return STRING_ELT(chr, i); } static inline void r_chr_poke(sexp* chr, r_ssize_t i, sexp* elt) { SET_STRING_ELT(chr, i, elt); } static inline const char* r_chr_get_c_string(sexp* chr, r_ssize_t i) { return CHAR(STRING_ELT(chr, i)); } static inline sexp* r_nms_get(sexp* nms, r_ssize_t i) { if (nms == r_null) { static sexp* empty_str = NULL; if (!empty_str) empty_str = Rf_mkChar(""); return empty_str; } else { return r_chr_get(nms, i); } } bool r_chr_has(sexp* chr, const char* c_string); sexp* r_new_character(const char** strings, int n); static inline sexp* r_string(const char* c_string) { return Rf_mkChar(c_string); } static inline bool r_is_r_string(sexp* x) { return r_typeof(x) == CHARSXP; } static inline sexp* r_scalar_chr(const char* c_string) { return Rf_mkString(c_string); } static inline sexp* r_as_scalar_chr(sexp* x) { return Rf_ScalarString(x); } static inline const char* r_c_string(sexp* scalar_chr) { return CHAR(r_chr_get(scalar_chr, 0)); } sexp* chr_prepend(sexp* chr, sexp* r_string); sexp* chr_append(sexp* chr, sexp* r_string); static inline bool r_is_empty_string(sexp* str) { const char* c_str = CHAR(str); return strcmp(c_str, "") == 0; } static inline bool r_chr_has_empty_string_at(sexp* chr, r_ssize_t i) { return r_is_empty_string(r_chr_get(chr, i)); } sexp* r_str_unserialise_unicode(sexp* r_string); static inline bool r_is_string(sexp* x, const char* string) { if (r_typeof(x) != r_type_character || r_length(x) != 1) { return false; } if (string && strcmp(r_c_string(x), string) != 0) { return false; } return true; } static inline const char* r_str_as_c_string(sexp* str) { return CHAR(str); } static inline sexp* r_str_as_symbol(sexp* str) { return r_sym(CHAR(str)); } static inline bool r_str_is_name(sexp* str) { if (str == r_missing_str) { return false; } if (r_is_empty_string(str)) { return false; } return true; } #endif rlang/src/lib/attrs.c0000644000176200001440000000273713242736425014234 0ustar liggesusers#define R_NO_REMAP #include // These change attributes in-place. sexp* rlang_zap_attrs(sexp* x) { SET_ATTRIB(x, r_null); return x; } sexp* rlang_set_attrs(sexp* x, sexp* attrs) { SET_ATTRIB(x, attrs); return x; } sexp* rlang_get_attrs(sexp* x) { return ATTRIB(x); } sexp* r_push_attribute(sexp* x, sexp* tag, sexp* value) { sexp* attrs = r_new_node(value, r_get_attributes(x)); r_poke_attributes(x, attrs); r_node_poke_tag(attrs, tag); return attrs; } // Unlike Rf_getAttrib(), this never allocates sexp* r_get_attribute(sexp* x, sexp* tag) { sexp* attrs = r_get_attributes(x); while (attrs != r_null) { if (r_node_tag(attrs) == tag) { sexp* attr = r_node_car(attrs); r_mark_shared(attr); return attr; } attrs = r_node_cdr(attrs); } return r_null; } /* * TODO: * * push: assumes there is no `class` attribute in the node list * merge: looks for `class` attribute first * */ // Caller must poke the object bit sexp* r_node_push_classes(sexp* node, const char** tags, int n) { static sexp* class_sym = NULL; if (!class_sym) { class_sym = r_sym("class"); } sexp* tags_chr = KEEP(r_new_character(tags, n)); sexp* attrs = r_new_node(tags_chr, node); r_node_poke_tag(attrs, class_sym); FREE(1); return attrs; } void r_push_classes(sexp* x, const char** tags, int n) { sexp* attrs = r_get_attributes(x); attrs = r_node_push_classes(attrs, tags, n); SET_ATTRIB(x, attrs); SET_OBJECT(x, 1); } rlang/src/lib/stack.c0000644000176200001440000000372313242736425014200 0ustar liggesusers#include "rlang.h" sexp* rlang_ns_get(const char* name); void r_on_exit(sexp* expr, sexp* frame) { static sexp* on_exit_prim = NULL; if (!on_exit_prim) { on_exit_prim = r_base_ns_get("on.exit"); } sexp* args = r_build_pairlist2(expr, r_scalar_lgl(1)); sexp* lang = KEEP(r_build_call_node(on_exit_prim, args)); r_eval(lang, frame); FREE(1); } static sexp* current_frame_call = NULL; sexp* r_current_frame() { return r_eval(current_frame_call, r_empty_env); } sexp* sys_frame_call = NULL; sexp* sys_call_call = NULL; int* sys_frame_n_addr = NULL; int* sys_call_n_addr = NULL; sexp* r_sys_frame(int n, sexp* frame) { if (!frame) { frame = r_current_frame(); } *sys_frame_n_addr = n; return r_eval(sys_frame_call, frame); } sexp* r_sys_call(int n, sexp* frame) { if (!frame) { frame = r_current_frame(); } *sys_call_n_addr = n; return r_eval(sys_call_call, frame); } static sexp* generate_sys_call(const char* name, int** n_addr) { sexp* sys_n = KEEP(r_scalar_int(0)); *n_addr = r_int_deref(sys_n); sexp* sys_args = KEEP(r_new_node(sys_n, r_null)); sexp* sys_call = KEEP(r_new_call_node(r_base_ns_get(name), sys_args)); r_mark_precious(sys_call); FREE(3); return sys_call; } void r_init_library_stack() { sexp* current_frame_args; current_frame_args = KEEP(r_scalar_int(-1)); current_frame_args = KEEP(r_new_node(current_frame_args, r_null)); sexp* current_frame_body = r_new_call_node(r_base_ns_get("sys.frame"), current_frame_args); sexp* current_frame_fn = KEEP(r_new_function(r_null, current_frame_body, r_empty_env)); current_frame_call = r_new_call_node(current_frame_fn, r_null); r_mark_precious(current_frame_call); FREE(3); sys_frame_call = generate_sys_call("sys.frame", &sys_frame_n_addr); sys_call_call = generate_sys_call("sys.call", &sys_call_n_addr); } rlang/src/lib/formula.h0000644000176200001440000000032313242736425014536 0ustar liggesusers#ifndef RLANG_FORMULA_H #define RLANG_FORMULA_H bool r_is_formulaish(sexp* x, int scoped, int lhs); sexp* r_f_rhs(sexp* f); sexp* r_f_lhs(sexp* f); sexp* r_f_env(sexp* f); bool r_f_has_env(sexp* f); #endif rlang/src/lib/cnd.c0000644000176200001440000000726513242736425013644 0ustar liggesusers#include "rlang.h" sexp* rlang_ns_get(const char* name); #define BUFSIZE 8192 #define INTERP(BUF, FMT, DOTS) \ { \ va_list dots; \ va_start(dots, FMT); \ vsnprintf(BUF, BUFSIZE, FMT, dots); \ va_end(dots); \ \ BUF[BUFSIZE - 1] = '\0'; \ } void r_inform(const char* fmt, ...) { char buf[BUFSIZE]; INTERP(buf, fmt, ...); sexp* buf_chr = KEEP(r_scalar_chr(buf)); sexp* lang = KEEP(r_build_call_node(r_sym("message"), buf_chr)); r_eval(lang, R_BaseEnv); FREE(2); } void r_warn(const char* fmt, ...) { char buf[BUFSIZE]; INTERP(buf, fmt, ...); sexp* args = KEEP(r_build_node(Rf_ScalarLogical(0), r_null)); r_node_poke_tag(args, r_sym("call.")); args = KEEP(r_build_node(r_scalar_chr(buf), args)); sexp* lang = KEEP(r_build_call_node(r_sym("warning"), args)); r_eval(lang, R_BaseEnv); FREE(3); } void r_abort(const char* fmt, ...) { char buf[BUFSIZE]; INTERP(buf, fmt, ...); Rf_errorcall(r_null, buf); while (1); // No return } sexp* r_interp_str(const char* fmt, ...) { char buf[BUFSIZE]; INTERP(buf, fmt, ...); return r_scalar_chr(buf); } static sexp* new_condition_names(sexp* data) { if (!r_is_named(data)) { r_abort("Conditions must have named data fields"); } sexp* data_nms = r_vec_names(data); if (r_chr_has(data_nms, "message")) { r_abort("Conditions can't have a `message` data field"); } sexp* nms = KEEP(r_new_vector(STRSXP, r_length(data) + 1)); r_chr_poke(nms, 0, r_string("message")); r_vec_poke_n(nms, 1, data_nms, 0, r_length(nms) - 1); FREE(1); return nms; } sexp* r_new_condition(sexp* type, sexp* data, sexp* msg) { if (!r_is_null(msg) && !r_is_scalar_character(msg)) { r_abort("Condition message must be a string"); } r_ssize_t n_data = r_length(data); sexp* cnd = KEEP(r_new_vector(VECSXP, n_data + 1)); r_list_poke(cnd, 0, msg); r_vec_poke_n(cnd, 1, data, 0, r_length(cnd) - 1); r_poke_names(cnd, KEEP(new_condition_names(data))); r_poke_class(cnd, KEEP(chr_append(type, r_string("condition")))); FREE(3); return cnd; } static sexp* with_muffle_lang(sexp* signal) { static sexp* muffle_node = NULL; if (!muffle_node) { muffle_node = r_build_pairlist(rlang_ns_get("muffle")); R_PreserveObject(muffle_node); r_node_poke_tag(muffle_node, r_sym("muffle")); } sexp* args = KEEP(r_build_node(signal, muffle_node)); sexp* lang = r_build_call_node(r_sym("withRestarts"), args); FREE(1); return lang; } static void cnd_signal_impl(const char* signaller, sexp* cnd, bool mufflable) { int n_protect = 0; if (r_typeof(cnd) == STRSXP) { cnd = KEEP_N(r_new_condition(cnd, r_null, r_null), n_protect); } else if (!r_is_condition(cnd)) { r_abort("`cnd` must be a condition"); } sexp* lang = KEEP_N(r_build_call1(r_sym(signaller), cnd), n_protect); if (mufflable) { sexp* muffable_str = KEEP_N(r_string("mufflable"), n_protect); sexp* classes = KEEP_N(chr_prepend(r_get_class(cnd), muffable_str), n_protect); SETCADR(lang, r_set_class(cnd, classes)); lang = KEEP_N(with_muffle_lang(lang), n_protect); } r_eval(lang, R_BaseEnv); FREE(n_protect); } void r_cnd_signal(sexp* cnd, bool mufflable) { cnd_signal_impl("signalCondition", cnd, mufflable); } void r_cnd_inform(sexp* cnd, bool mufflable) { cnd_signal_impl("message", cnd, mufflable); } void r_cnd_warn(sexp* cnd, bool mufflable) { cnd_signal_impl("warning", cnd, mufflable); } void r_cnd_abort(sexp* cnd, bool mufflable) { cnd_signal_impl("stop", cnd, mufflable); } rlang/src/lib/node.h0000644000176200001440000000436213242736425014025 0ustar liggesusers#ifndef RLANG_NODE_H #define RLANG_NODE_H static inline sexp* r_node_car(sexp* x) { return CAR(x); } static inline sexp* r_node_cdr(sexp* x) { return CDR(x); } static inline sexp* r_node_caar(sexp* x) { return CAAR(x); } static inline sexp* r_node_cadr(sexp* x) { return CADR(x); } static inline sexp* r_node_cdar(sexp* x) { return CDAR(x); } static inline sexp* r_node_cddr(sexp* x) { return CDDR(x); } static inline sexp* r_node_tail(sexp* x) { while (CDR(x) != R_NilValue) x = CDR(x); return x; } static inline sexp* r_node_poke_car(sexp* x, sexp* newcar) { SETCAR(x, newcar); return x; } static inline sexp* r_node_poke_cdr(sexp* x, sexp* newcdr) { SETCDR(x, newcdr); return x; } static inline sexp* r_node_poke_caar(sexp* x, sexp* newcaar) { SETCAR(CAR(x), newcaar); return x; } static inline sexp* r_node_poke_cadr(sexp* x, sexp* newcar) { SETCADR(x, newcar); return x; } static inline sexp* r_node_poke_cdar(sexp* x, sexp* newcdar) { SETCDR(CAR(x), newcdar); return x; } static inline sexp* r_node_poke_cddr(sexp* x, sexp* newcdr) { SETCDR(CDR(x), newcdr); return x; } static inline sexp* r_node_tag(sexp* x) { return TAG(x); } static inline sexp* r_node_poke_tag(sexp* x, sexp* tag) {SET_TAG(x, tag); return x; } static inline bool r_is_pairlist(sexp* x) { return TYPEOF(x) == LISTSXP; } static inline sexp* r_new_node(sexp* car, sexp* cdr) { return Rf_cons(car, cdr); } sexp* r_new_tagged_node(const char* tag, sexp* car, sexp* cdr); static inline sexp* r_new_node_list(sexp* car) { return Rf_cons(car, r_null); } static inline sexp* r_new_node_list2(sexp* car1, sexp* car2) { sexp* out = KEEP(Rf_cons(car2, r_null)); out = Rf_cons(car1, out); FREE(1); return out; } static inline sexp* r_build_node(sexp* car, sexp* cdr) { PROTECT(car); PROTECT(cdr); sexp* out = Rf_cons(car, cdr); UNPROTECT(2); return out; } static inline sexp* r_build_pairlist(sexp* car) { return r_build_node(car, r_null); } static inline sexp* r_build_pairlist2(sexp* car1, sexp* car2) { return r_build_node(car1, r_build_pairlist(car2)); } static inline sexp* r_build_pairlist3(sexp* car1, sexp* car2, sexp* car3) { return r_build_node(car1, r_build_pairlist2(car2, car3)); } sexp* r_node_tree_clone(sexp* x); #endif rlang/src/lib/vec-list.h0000644000176200001440000000046213242736425014623 0ustar liggesusers#ifndef RLANG_VECTOR_LIST_H #define RLANG_VECTOR_LIST_H static inline sexp* r_list_get(sexp* list, r_ssize_t i) { return VECTOR_ELT(list, i); } static inline void r_list_poke(sexp* list, r_ssize_t i, sexp* elt) { SET_VECTOR_ELT(list, i, elt); } sexp* r_new_list(sexp* x, const char* name); #endif rlang/src/lib/env.c0000644000176200001440000001167513242736425013670 0ustar liggesusers#include "rlang.h" sexp* r_ns_env(const char* pkg) { sexp* ns = r_env_get(R_NamespaceRegistry, r_sym(pkg)); if (ns == r_unbound_sym) { r_abort("Can't find namespace `%s`", pkg); } return ns; } static sexp* ns_env_get(sexp* env, const char* name) { sexp* obj = r_env_get(env, r_sym(name)); // Can be a promise to a lazyLoadDBfetch() call if (r_typeof(obj) == PROMSXP) { KEEP(obj); // Help rchk obj = r_eval(obj, r_empty_env); FREE(1); } return obj; } sexp* rlang_ns_get(const char* name) { return ns_env_get(r_ns_env("rlang"), name); } sexp* r_base_ns_get(const char* name) { return ns_env_get(r_base_env, name); } static sexp* new_env_call = NULL; sexp* r_new_environment(sexp* parent, r_ssize_t size) { if (!parent) { parent = r_empty_env; } sexp* parent_node = r_node_cdr(new_env_call); r_node_poke_car(parent_node, parent); if (!size) { size = 29; } sexp* size_node = r_node_cdr(parent_node); r_node_poke_car(size_node, r_scalar_int(size)); sexp* env = r_eval(new_env_call, r_empty_env); r_node_poke_car(parent_node, r_null); return env; } static sexp* env2list_call = NULL; sexp* r_env_as_list(sexp* x) { sexp* arg_node = r_node_cdr(env2list_call); r_node_poke_car(arg_node, x); sexp* env = r_eval(env2list_call, r_empty_env); // Release input node for GC r_node_poke_car(arg_node, r_null); return env; } static sexp* list2env_call = NULL; sexp* r_list_as_environment(sexp* x, sexp* parent) { if (parent == NULL) { parent = r_empty_env; } sexp* input_node = r_node_cdr(list2env_call); r_node_poke_car(input_node, x); sexp* parent_node = r_node_cddr(input_node); r_node_poke_car(parent_node, parent); sexp* env = r_eval(list2env_call, r_empty_env); // Release input list for GC r_node_poke_car(input_node, r_null); r_node_poke_car(parent_node, r_null); return env; } sexp* r_env_clone(sexp* env, sexp* parent) { if (parent == NULL) { parent = r_env_parent(env); } sexp* list = KEEP(r_env_as_list(env)); sexp* clone = r_list_as_environment(list, parent); FREE(1); return clone; } static sexp* remove_call = NULL; sexp* r_env_unbind_names(sexp* env, sexp* names, bool inherits) { sexp* names_node = r_node_cdr(remove_call); r_node_poke_car(names_node, names); sexp* env_node = r_node_cdr(names_node); r_node_poke_car(env_node, env); sexp* inherits_node = r_node_cdr(env_node); r_node_poke_car(inherits_node, r_scalar_lgl(inherits)); // Evaluate call and free arguments for GC r_eval(remove_call, r_base_env); r_node_poke_car(names_node, r_null); r_node_poke_car(env_node, r_null); return env; } sexp* rlang_env_unbind(sexp* env, sexp* names, sexp* inherits) { if (r_typeof(env) != r_type_environment) { r_abort("`env` must be an environment"); } if (r_typeof(names) != r_type_character) { r_abort("`names` must be a character vector"); } if (!r_is_scalar_logical(inherits)) { r_abort("`inherits` must be a scalar logical vector"); } return r_env_unbind_names(env, names, *r_lgl_deref(inherits)); } sexp* r_env_unbind_all(sexp* env, const char** names, r_ssize_t n, bool inherits) { return r_env_unbind_names(env, r_new_character(names, n), inherits); } sexp* r_env_unbind(sexp* env, const char* name, bool inherits) { return r_env_unbind_all(env, &name, 1, inherits); } void r_init_library_env() { sexp* new_env_args = r_null; sexp* hash = KEEP(r_scalar_lgl(1)); new_env_args = KEEP(r_new_tagged_node("hash", hash, new_env_args)); new_env_args = KEEP(r_new_tagged_node("size", r_null, new_env_args)); new_env_args = KEEP(r_new_tagged_node("parent", r_null, new_env_args)); new_env_call = r_new_call_node(r_base_ns_get("new.env"), new_env_args); r_mark_precious(new_env_call); FREE(4); sexp* env2list_args; env2list_args = KEEP(r_scalar_lgl(1)); env2list_args = KEEP(r_new_tagged_node("all.names", env2list_args, r_null)); env2list_args = KEEP(r_new_tagged_node("x", r_null, env2list_args)); env2list_call = r_new_call_node(r_base_ns_get("as.list.environment"), env2list_args); r_mark_precious(env2list_call); FREE(3); sexp* list2env_args; list2env_args = KEEP(r_scalar_lgl(1)); list2env_args = KEEP(r_new_tagged_node("hash", list2env_args, r_null)); list2env_args = KEEP(r_new_tagged_node("parent", r_null, list2env_args)); list2env_args = KEEP(r_new_tagged_node("envir", r_null, list2env_args)); list2env_args = KEEP(r_new_tagged_node("x", r_null, list2env_args)); list2env_call = r_new_call_node(r_base_ns_get("list2env"), list2env_args); r_mark_precious(list2env_call); FREE(5); sexp* remove_args = r_null; sexp* inherits = KEEP(r_scalar_lgl(0)); remove_args = KEEP(r_new_tagged_node("inherits", inherits, remove_args)); remove_args = KEEP(r_new_tagged_node("envir", r_null, remove_args)); remove_args = KEEP(r_new_tagged_node("list", r_null, remove_args)); remove_call = r_new_call_node(r_base_ns_get("remove"), remove_args); r_mark_precious(remove_call); FREE(4); } rlang/src/lib/cnd.h0000644000176200001440000000113013242736425013632 0ustar liggesusers#ifndef RLANG_CND_H #define RLANG_CND_H #include void r_inform(const char* fmt, ...); void r_warn(const char* fmt, ...); void r_abort(const char* fmt, ...) __attribute__((noreturn)); sexp* r_interp_str(const char* fmt, ...); sexp* r_new_condition(sexp* type, sexp* data, sexp* msg); static inline bool r_is_condition(sexp* x) { return TYPEOF(x) == VECSXP && Rf_inherits(x, "condition"); } void r_cnd_signal(sexp* cnd, bool mufflable); void r_cnd_inform(sexp* cnd, bool mufflable); void r_cnd_warn(sexp* cnd, bool mufflable); void r_cnd_abort(sexp* cnd, bool mufflable); #endif rlang/src/lib/lang.h0000644000176200001440000000224513242736425014017 0ustar liggesusers#ifndef RLANG_LANG_H #define RLANG_LANG_H #include "node.h" static inline sexp* r_new_call_node(sexp* car, sexp* cdr) { return Rf_lcons(car, cdr); } static inline sexp* r_build_call_node(sexp* car, sexp* cdr) { sexp* out = KEEP(r_build_node(car, cdr)); SET_TYPEOF(out, LANGSXP); FREE(1); return out; } static inline sexp* r_build_call(sexp* head) { return r_build_call_node(head, r_null); } static inline sexp* r_build_call1(sexp* head, sexp* arg1) { return r_build_call_node(head, r_build_pairlist(arg1)); } static inline sexp* r_build_call2(sexp* head, sexp* arg1, sexp* arg2) { return r_build_call_node(head, r_build_pairlist2(arg1, arg2)); } bool r_is_call(sexp* x, const char* name); bool r_is_call_any(sexp* x, const char** names, int n); bool r_is_prefixed_call(sexp* x, const char* name); bool r_is_prefixed_call_any(sexp* x, const char ** names, int n); bool r_is_maybe_prefixed_call_any(sexp* x, const char ** names, int n); bool r_is_namespaced_call(sexp* x, const char* ns, const char* name); bool r_is_namespaced_call_any(sexp* x, const char* ns, const char** names, int n); bool r_is_special_op_call(sexp* x); sexp* r_expr_protect(sexp* x); #endif rlang/src/lib/sym.h0000644000176200001440000000130513242736425013702 0ustar liggesusers#ifndef RLANG_SYM_H #define RLANG_SYM_H #define r_unbound_sym R_UnboundValue #define r_missing_sym R_MissingArg #define r_names_sym R_NamesSymbol #define r_class_sym R_ClassSymbol sexp* r_new_symbol(sexp* x, int* err); static inline sexp* r_sym(const char* c_string) { return Rf_install(c_string); } static inline sexp* r_sym_str(sexp* sym) { return PRINTNAME(sym); } static inline const char* r_sym_c_str(sexp* sym) { return CHAR(PRINTNAME(sym)); } bool r_is_symbol(sexp* sym, const char* string); bool r_is_symbol_any(sexp* x, const char** strings, int n); bool r_is_special_op_sym(sexp* x); extern sexp* r_dot_environment_sym; extern sexp* r_function_sym; extern sexp* r_tilde_sym; #endif rlang/src/lib/fn.c0000644000176200001440000000045213242736425013472 0ustar liggesusers#include "rlang.h" sexp* r_new_function(sexp* formals, sexp* body, sexp* env) { sexp* args = KEEP(r_new_node(body, r_null)); args = KEEP(r_new_node(formals, args)); sexp* lang = KEEP(r_new_call_node(r_function_sym, args)); sexp* fn = r_eval(lang, r_base_env); FREE(3); return fn; } rlang/src/lib/attrs.h0000644000176200001440000000134413242736425014232 0ustar liggesusers#ifndef RLANG_ATTRS_H #define RLANG_ATTRS_H static inline sexp* r_get_attributes(sexp* x) { return ATTRIB(x); } static inline void r_poke_attributes(sexp* x, sexp* attrs) { SET_ATTRIB(x, attrs); } sexp* r_push_attribute(sexp* x, sexp* tag, sexp* value); sexp* r_get_attribute(sexp* x, sexp* tag); static inline void r_push_names(sexp* x, sexp* value) { r_push_attribute(x, R_NamesSymbol, value); } sexp* r_node_push_classes(sexp* x, const char** tags, int n); static inline sexp* r_node_push_class(sexp* x, const char* tag) { return r_node_push_classes(x, &tag, 1); } void r_push_classes(sexp* x, const char** tags, int n); static inline void r_push_class(sexp* x, const char* tag) { r_push_classes(x, &tag, 1); } #endif rlang/src/lib/sexp.c0000644000176200001440000000077113242736425014052 0ustar liggesusers#include "rlang.h" sexp* r_set_attribute(sexp* x, sexp* sym, sexp* attr) { x = KEEP(r_duplicate(x, true)); r_poke_attribute(x, sym, attr); FREE(1); return x; } bool r_is_named(sexp* x) { sexp* nms = r_vec_names(x); if (r_typeof(nms) != STRSXP) { return false; } if (r_chr_has(nms, "")) { return false; } return true; } bool r_has_name_at(sexp* x, r_ssize_t i) { sexp* nms = r_vec_names(x); return r_is_character(nms) && !r_chr_has_empty_string_at(nms, i); } rlang/src/lib/rlang.c0000644000176200001440000000174013242736425014173 0ustar liggesusers#include void r_init_library_env(); void r_init_library_stack(); void r_init_library_sym(); // This *must* be called before making any calls to the functions // provided in the library void r_init_library() { r_init_library_sym(); // Needs to be first r_init_library_env(); r_init_library_stack(); r_quo_get_expr = (sexp* (*)(sexp*)) r_peek_c_callable("rlang", "rlang_quo_get_expr"); r_quo_set_expr = (sexp* (*)(sexp*, sexp*)) r_peek_c_callable("rlang", "rlang_quo_set_expr"); r_quo_get_env = (sexp* (*)(sexp*)) r_peek_c_callable("rlang", "rlang_quo_get_env"); r_quo_set_env = (sexp* (*)(sexp*, sexp*)) r_peek_c_callable("rlang", "rlang_quo_set_env"); /* parse.c - r_ops_precedence[] */ RLANG_ASSERT((sizeof(r_ops_precedence) / sizeof(struct r_op_precedence)) == R_OP_MAX); for (int i = R_OP_NONE + 1; i < R_OP_MAX; ++i) { if (r_ops_precedence[i].power == 0) { r_abort("Internal error: `r_ops_precedence` is not fully initialised"); } } } rlang/src/lib/eval.h0000644000176200001440000000021013242736425014013 0ustar liggesusers#ifndef RLANG_EVAL_H #define RLANG_EVAL_H static inline sexp* r_eval(sexp* expr, sexp* env) { return Rf_eval(expr, env); } #endif rlang/src/lib/vec.c0000644000176200001440000001234313242736425013646 0ustar liggesusers#include "rlang.h" bool r_is_atomic(sexp* x) { switch(r_typeof(x)) { case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: return true; default: return false; } } bool r_is_scalar_atomic(sexp* x) { return r_length(x) == 1 && r_is_atomic(x); } bool r_is_integerish(sexp* x) { static sexp* predicate = NULL; if (!predicate) { predicate = rlang_ns_get("is_integerish"); } sexp* call = KEEP(r_build_call1(predicate, x)); sexp* out = r_eval(call, r_empty_env); FREE(1); return out; } bool r_is_list(sexp* x) { return r_typeof(x) == VECSXP; } bool r_is_vector(sexp* x) { switch(r_typeof(x)) { case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: case VECSXP: return true; default: return false; } } r_ssize_t r_vec_length(sexp* x) { switch(r_typeof(x)) { case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: case VECSXP: case NILSXP: return r_length(x); default: r_abort("Internal error: expected a vector"); } } sexp* r_vec_get(sexp* vec, r_ssize_t i) { switch (r_typeof(vec)) { case r_type_character: return r_chr_get(vec, i); case r_type_list: return r_list_get(vec, i); default: r_abort("Internal error: Unimplemented type in `r_vec_get()`"); } } bool r_vec_find_first_identical_any(sexp* x, sexp* y, r_long_ssize_t* index) { if (r_typeof(x) != r_type_list && r_typeof(x) != r_type_character) { r_abort("Internal error: `x` must be a list or character vector in `r_vec_find_first_identical_any()`"); } if (r_typeof(y) != r_type_list && r_typeof(y) != r_type_character) { r_abort("Internal error: `y` must be a list or character vector in `r_vec_find_first_identical_any()`"); } r_ssize_t n = r_length(x); r_ssize_t n_comparisons = r_length(y); for (r_ssize_t i = 0; i < n; ++i) { sexp* elt = r_vec_get(x, i); for (r_ssize_t j = 0; j < n_comparisons; ++j) { if (r_is_identical(elt, r_vec_get(y, j))) { if (index) { *index = i; } return true; } } } return false; } // Copy -------------------------------------------------------------- void r_vec_poke_n(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t n) { if ((r_length(x) - offset) < n) { r_abort("Can't copy data to `x` because it is too small"); } if ((r_length(y) - from) < n) { r_abort("Can't copy data from `y` because it is too small"); } switch (r_typeof(x)) { case LGLSXP: { int* src_data = LOGICAL(y); int* dest_data = LOGICAL(x); for (r_ssize_t i = 0; i != n; ++i) dest_data[i + offset] = src_data[i + from]; break; } case INTSXP: { int* src_data = INTEGER(y); int* dest_data = INTEGER(x); for (r_ssize_t i = 0; i != n; ++i) dest_data[i + offset] = src_data[i + from]; break; } case REALSXP: { double* src_data = REAL(y); double* dest_data = REAL(x); for (r_ssize_t i = 0; i != n; ++i) dest_data[i + offset] = src_data[i + from]; break; } case CPLXSXP: { r_complex_t* src_data = COMPLEX(y); r_complex_t* dest_data = COMPLEX(x); for (r_ssize_t i = 0; i != n; ++i) dest_data[i + offset] = src_data[i + from]; break; } case RAWSXP: { r_byte_t* src_data = RAW(y); r_byte_t* dest_data = RAW(x); for (r_ssize_t i = 0; i != n; ++i) dest_data[i + offset] = src_data[i + from]; break; } case STRSXP: { sexp* elt; for (r_ssize_t i = 0; i != n; ++i) { elt = STRING_ELT(y, i + from); SET_STRING_ELT(x, i + offset, elt); } break; } case VECSXP: { sexp* elt; for (r_ssize_t i = 0; i != n; ++i) { elt = VECTOR_ELT(y, i + from); SET_VECTOR_ELT(x, i + offset, elt); } break; } default: r_abort("Copy requires vectors"); } } void r_vec_poke_range(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t to) { r_vec_poke_n(x, offset, y, from, to - from + 1); } // Coercion ---------------------------------------------------------- sexp* rlang_vec_coercer(sexp* dest) { switch(r_typeof(dest)) { case LGLSXP: return rlang_ns_get("as_logical"); case INTSXP: return rlang_ns_get("as_integer"); case REALSXP: return rlang_ns_get("as_double"); case CPLXSXP: return rlang_ns_get("as_complex"); case STRSXP: return rlang_ns_get("as_character"); case RAWSXP: return rlang_ns_get("as_bytes"); default: r_abort("No coercion implemented for `%s`", Rf_type2str(r_typeof(dest))); } } void r_vec_poke_coerce_n(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t n) { if (r_typeof(y) == r_typeof(x)) { r_vec_poke_n(x, offset, y, from, n); return ; } if (r_is_object(y)) { r_abort("Can't splice S3 objects"); } // FIXME: This callbacks to rlang R coercers with an extra copy. sexp* coercer = rlang_vec_coercer(x); sexp* call = KEEP(Rf_lang2(coercer, y)); sexp* coerced = KEEP(r_eval(call, R_BaseEnv)); r_vec_poke_n(x, offset, coerced, from, n); FREE(2); } void r_vec_poke_coerce_range(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t to) { r_vec_poke_coerce_n(x, offset, y, from, to - from + 1); } rlang/src/lib/eval.c0000644000176200001440000000002313242736425014010 0ustar liggesusers#include "rlang.h" rlang/src/lib/lang.c0000644000176200001440000000500513242736425014007 0ustar liggesusers#include "rlang.h" bool r_is_call(sexp* x, const char* name) { if (r_typeof(x) != LANGSXP) { return false; } else { return name == NULL || r_is_symbol(r_node_car(x), name); } } bool r_is_call_any(sexp* x, const char** names, int n) { if (r_typeof(x) != LANGSXP) { return false; } else { return r_is_symbol_any(r_node_car(x), names, n); } } #define R_SUBSET_NAMES_N 4 static const char* r_subset_names[R_SUBSET_NAMES_N] = { "$", "@", "::", ":::" }; bool r_is_prefixed_call(sexp* x, const char* name) { if (r_typeof(x) != LANGSXP) { return false; } sexp* head = r_node_car(x); if (!r_is_call_any(head, r_subset_names, R_SUBSET_NAMES_N)) { return false; } if (name) { sexp* rhs = r_node_cadr(r_node_cdr(head)); if (!r_is_symbol(rhs, name)) { return false; } } return true; } bool r_is_prefixed_call_any(sexp* x, const char ** names, int n) { if (r_typeof(x) != LANGSXP) { return false; } sexp* head = r_node_car(x); if (!r_is_call_any(head, r_subset_names, R_SUBSET_NAMES_N)) { return false; } sexp* args = r_node_cdar(x); sexp* sym = r_node_cadr(args); return r_is_symbol_any(sym, names, n); } bool r_is_maybe_prefixed_call_any(sexp* x, const char ** names, int n) { if (r_typeof(x) != LANGSXP) { return false; } if (r_is_symbol_any(r_node_car(x), names, n)) { return true; } return r_is_prefixed_call_any(x, names, n); } bool r_is_namespaced_call(sexp* x, const char* ns, const char* name) { if (r_typeof(x) != LANGSXP) { return false; } sexp* head = r_node_car(x); if (!r_is_call(head, "::")) { return false; } if (ns) { sexp* lhs = r_node_cadr(head); if (!r_is_symbol(lhs, ns)) { return false; } } if (name) { sexp* rhs = r_node_cadr(r_node_cdar(x)); if (!r_is_symbol(rhs, name)) { return false; } } return true; } bool r_is_namespaced_call_any(sexp* x, const char* ns, const char** names, int n) { if (!r_is_namespaced_call(x, ns, NULL)) { return false; } sexp* args = r_node_cdar(x); sexp* sym = r_node_cadr(args); return r_is_symbol_any(sym, names, n); } bool r_is_special_op_call(sexp* x) { return r_typeof(x) == LANGSXP && r_is_special_op_sym(r_node_car(x)); } sexp* r_expr_protect(sexp* x) { static sexp* quote_prim = NULL; if (!quote_prim) quote_prim = r_base_ns_get("quote"); sexp* args = KEEP(r_new_node(x, r_null)); sexp* out = r_new_call_node(quote_prim, args); FREE(1); return out; } rlang/src/lib/sexp.h0000644000176200001440000000517613242736425014063 0ustar liggesusers#ifndef RLANG_SEXP_H #define RLANG_SEXP_H static inline r_ssize_t r_length(sexp* x) { return Rf_length(x); } static inline enum r_type r_typeof(sexp* x) { return TYPEOF(x); } #define r_mark_precious R_PreserveObject #define r_unmark_precious R_ReleaseObject static inline void r_mark_shared(sexp* x) { MARK_NOT_MUTABLE(x); } static inline bool r_is_shared(sexp* x) { return MAYBE_SHARED(x); } static inline void r_mark_object(sexp* x) { SET_OBJECT(x, 1); } static inline void r_unmark_object(sexp* x) { SET_OBJECT(x, 0); } static inline bool r_is_object(sexp* x) { return OBJECT(x); } static inline bool r_inherits(sexp* x, const char* tag) { return Rf_inherits(x, tag); } static inline void r_poke_attribute(sexp* x, sexp* sym, sexp* value) { Rf_setAttrib(x, sym, value); } static inline void r_poke_class(sexp* x, sexp* classes) { Rf_setAttrib(x, R_ClassSymbol, classes); } sexp* r_set_attribute(sexp* x, sexp* sym, sexp* attr); static inline sexp* r_set_class(sexp* x, sexp* classes) { return r_set_attribute(x, R_ClassSymbol, classes); } static inline sexp* r_get_class(sexp* x) { return Rf_getAttrib(x, R_ClassSymbol); } // From attrs.c sexp* r_get_attribute(sexp* x, sexp* tag); static inline sexp* r_vec_names(sexp* x) { return r_get_attribute(x, R_NamesSymbol); } static inline void r_poke_names(sexp* x, sexp* nms) { Rf_setAttrib(x, R_NamesSymbol, nms); } bool r_has_name_at(sexp* x, r_ssize_t i); bool r_is_named(sexp* x); static inline sexp* r_missing_arg() { return R_MissingArg; } static inline bool r_is_missing(sexp* x) { return x == R_MissingArg; } static inline bool r_is_null(sexp* x) { return x == R_NilValue; } static inline sexp* r_duplicate(sexp* x, bool shallow) { if (shallow) { return Rf_shallow_duplicate(x); } else { return Rf_duplicate(x); } } static inline sexp* r_maybe_duplicate(sexp* x, bool shallow) { if (r_is_shared(x)) { return r_duplicate(x, shallow); } else { return x; } } static inline sexp* r_poke_type(sexp* x, enum r_type type) { SET_TYPEOF(x, type); return x; } static inline sexp* r_poke_str_type(sexp* x, const char* type) { SET_TYPEOF(x, Rf_str2type(type)); return x; } static inline const char* r_type_c_string(enum r_type type) { return CHAR(Rf_type2str(type)); } static inline bool r_is_symbolic(sexp* x) { return r_typeof(x) == LANGSXP || r_typeof(x) == SYMSXP; } static inline void r_sxp_print(sexp* x) { Rf_PrintValue(x); } static inline bool r_is_identical(sexp* x, sexp* y) { // 16 corresponds to base::identical()'s defaults // Do we need less conservative versions? return R_compute_identical(x, y, 16); } #endif rlang/src/lib/export.c0000644000176200001440000000202513242736425014406 0ustar liggesusers#include "rlang.h" #include "export.h" #include #if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0)) sexp* R_MakeExternalPtrFn(DL_FUNC p, sexp* tag, sexp* prot) { fn_ptr ptr; ptr.fn = p; return R_MakeExternalPtr(ptr.p, tag, prot); } DL_FUNC R_ExternalPtrAddrFn(sexp* s) { fn_ptr ptr; ptr.p = EXTPTR_PTR(s); return ptr.fn; } #endif sexp* rlang_namespace(const char* ns) { sexp* ns_string = KEEP(Rf_mkString(ns)); sexp* call = KEEP(r_sym("getNamespace")); call = KEEP(Rf_lang2(call, ns_string)); sexp* ns_env = r_eval(call, R_BaseEnv); FREE(3); return ns_env; } void rlang_register_pointer(const char* ns, const char* ptr_name, DL_FUNC fn) { sexp* ptr = KEEP(R_MakeExternalPtrFn(fn, r_null, r_null)); sexp* ptr_obj = KEEP(r_new_vector(VECSXP, 1)); SET_VECTOR_ELT(ptr_obj, 0, ptr); sexp* ptr_class = KEEP(Rf_mkString("fn_pointer")); Rf_setAttrib(ptr_obj, R_ClassSymbol, ptr_class); sexp* ns_env = KEEP(rlang_namespace(ns)); Rf_defineVar(r_sym(ptr_name), ptr_obj, ns_env); FREE(4); } rlang/src/lib/parse.h0000644000176200001440000000502513242736425014207 0ustar liggesusers#ifndef RLANG_PARSE_H #define RLANG_PARSE_H // This only includes operators that actually appear in the AST. // Examples of silent operators are `else` and `in`. enum r_operator { R_OP_NONE = 0, R_OP_FUNCTION, R_OP_WHILE, R_OP_FOR, R_OP_REPEAT, R_OP_IF, R_OP_QUESTION, R_OP_QUESTION_UNARY, R_OP_ASSIGN1, R_OP_ASSIGN2, R_OP_ASSIGN_EQUAL, R_OP_COLON_EQUAL, R_OP_TILDE, R_OP_TILDE_UNARY, R_OP_OR1, R_OP_OR2, R_OP_AND1, R_OP_AND2, R_OP_BANG1, R_OP_BANG3, R_OP_GREATER, R_OP_GREATER_EQUAL, R_OP_LESS, R_OP_LESS_EQUAL, R_OP_EQUAL, R_OP_NOT_EQUAL, R_OP_PLUS, R_OP_MINUS, R_OP_TIMES, R_OP_RATIO, R_OP_MODULO, R_OP_SPECIAL, R_OP_COLON1, R_OP_BANG2, R_OP_PLUS_UNARY, R_OP_MINUS_UNARY, R_OP_HAT, R_OP_DOLLAR, R_OP_AT, R_OP_COLON2, R_OP_COLON3, R_OP_PARENTHESES, R_OP_BRACKETS1, R_OP_BRACKETS2, R_OP_BRACES, R_OP_MAX }; enum r_operator r_which_operator(sexp* call); const char* r_op_as_c_string(enum r_operator op); /** * struct r_op_precedence - Information about operator precedence * * @power: Binding power. Absolute value has no meaning, only the * relative ordering between operators has meaning. * @assoc: -1 if left associative, 0 if non-associative, 1 if right associative. * @unary: `false` if a binary operation. * @delimited: `true` if an operation like `(` or `{`. */ struct r_op_precedence { uint8_t power; int8_t assoc; bool unary; bool delimited; }; const struct r_op_precedence r_ops_precedence[R_OP_MAX]; /** * r_op_has_precedence() - Does an operation have precedence over another? * * Relies on information in the table of operation metadata * %r_ops_precedence. * * @x The call that was found lower in the AST (i.e. the call that is * supposed to have precedence). * @parent The call that was found earlier in the AST (i.e. the one * that wraps @x). */ bool r_op_has_precedence(enum r_operator x, enum r_operator parent); bool r_rhs_op_has_precedence(enum r_operator rhs, enum r_operator parent); bool r_lhs_op_has_precedence(enum r_operator lhs, enum r_operator parent); static inline bool r_call_has_precedence(sexp* x, sexp* parent) { return r_op_has_precedence(r_which_operator(x), r_which_operator(parent)); } static inline bool r_lhs_call_has_precedence(sexp* lhs, sexp* parent) { return r_lhs_op_has_precedence(r_which_operator(lhs), r_which_operator(parent)); } static inline bool r_rhs_call_has_precedence(sexp* rhs, sexp* parent) { return r_rhs_op_has_precedence(r_which_operator(rhs), r_which_operator(parent)); } #endif rlang/src/lib/replace-na.c0000644000176200001440000000456213242736425015104 0ustar liggesusers#include "rlang.h" static sexp* replace_na_(sexp* x, sexp* replacement, int start); sexp* rlang_replace_na(sexp* x, sexp* replacement) { int n = r_length(x); int i = 0; switch(r_typeof(x)) { case LGLSXP: { int* arr = LOGICAL(x); for (; i < n; ++i) { if (arr[i] == NA_LOGICAL) { break; } } break; } case INTSXP: { int* arr = INTEGER(x); for (; i < n; ++i) { if (arr[i] == NA_INTEGER) { break; } } break; } case REALSXP: { double* arr = REAL(x); for (; i < n; ++i) { if (ISNA(arr[i])) { break; } } break; } case STRSXP: { for (; i < n; ++i) { if (STRING_ELT(x, i) == NA_STRING) { break; } } break; } case CPLXSXP: { r_complex_t* arr = COMPLEX(x); for (; i < n; ++i) { if (ISNA(arr[i].r)) { break; } } break; } default: { r_abort("Don't know how to handle object of type", Rf_type2char(r_typeof(x))); } } if (i < n) { return replace_na_(x, replacement, i); } else { return x; } } static sexp* replace_na_(sexp* x, sexp* replacement, int i) { KEEP(x = Rf_duplicate(x)); int n = r_length(x); switch(r_typeof(x)) { case LGLSXP: { int* arr = LOGICAL(x); int new_value = LOGICAL(replacement)[0]; for (; i < n; ++i) { if (arr[i] == NA_LOGICAL) { arr[i] = new_value; } } break; } case INTSXP: { int* arr = INTEGER(x); int new_value = INTEGER(replacement)[0]; for (; i < n; ++i) { if (arr[i] == NA_INTEGER) { arr[i] = new_value; } } break; } case REALSXP: { double* arr = REAL(x); double new_value = REAL(replacement)[0]; for (; i < n; ++i) { if (ISNA(arr[i])) { arr[i] = new_value; } } break; } case STRSXP: { sexp* new_value = STRING_ELT(replacement, 0); for (; i < n; ++i) { if (STRING_ELT(x, i) == NA_STRING) { SET_STRING_ELT(x, i, new_value); } } break; } case CPLXSXP: { r_complex_t* arr = COMPLEX(x); r_complex_t new_value = COMPLEX(replacement)[0]; for (; i < n; ++i) { if (ISNA(arr[i].r)) { arr[i] = new_value; } } break; } default: { r_abort("Don't know how to handle object of type", Rf_type2char(r_typeof(x))); } } FREE(1); return x; } rlang/src/lib/quo.c0000644000176200001440000000027113242736425013672 0ustar liggesusers#include "rlang.h" sexp* (*r_quo_get_expr)(sexp* quo); sexp* (*r_quo_set_expr)(sexp* quo, sexp* expr); sexp* (*r_quo_get_env)(sexp* quo); sexp* (*r_quo_set_env)(sexp* quo, sexp* env); rlang/src/lib/debug.h0000644000176200001440000000012013242736425014152 0ustar liggesusers#ifndef RLANG_DEBUG_H #define RLANG_DEBUG_H #define r_printf Rprintf #endif rlang/src/lib/state.h0000644000176200001440000000023113242736425014207 0ustar liggesusers#ifndef RLANG_STATE_H #define RLANG_STATE_H static inline sexp* r_peek_option(const char* name) { return Rf_GetOption1(Rf_install(name)); } #endif rlang/src/lib/sym.c0000644000176200001440000000277413242736425013710 0ustar liggesusers#include #include "rlang.h" // In old R versions `as.name()` does not translate to native which // loses the encoding. This symbol constructor always translates. sexp* r_new_symbol(sexp* x, int* err) { switch (r_typeof(x)) { case SYMSXP: return x; case STRSXP: if (r_length(x) == 1) { const char* string = Rf_translateChar(r_chr_get(x, 0)); return r_sym(string); } // else fallthrough default: { if (err) { *err = -1; return r_null; } else { const char* type = r_type_c_string(r_typeof(x)); r_abort("Can't create a symbol with a %s", type); } }} } bool r_is_symbol(sexp* x, const char* string) { if (r_typeof(x) != SYMSXP) { return false; } else { return strcmp(CHAR(PRINTNAME(x)), string) == 0; } } bool r_is_symbol_any(sexp* x, const char** strings, int n) { if (r_typeof(x) != SYMSXP) { return false; } const char* name = CHAR(PRINTNAME(x)); for (int i = 0; i < n; ++i) { if (strcmp(name, strings[i]) == 0) { return true; } } return false; } bool r_is_special_op_sym(sexp* x) { if (r_typeof(x) != SYMSXP) { return false; } const char* name = CHAR(PRINTNAME(x)); size_t len = strlen(name); return len > 2 && name[0] == '%' && name[len - 1] == '%'; } sexp* r_dot_environment_sym; sexp* r_function_sym; sexp* r_tilde_sym; void r_init_library_sym() { r_dot_environment_sym = r_sym(".Environment"); r_function_sym = r_sym("function"); r_tilde_sym = r_sym("~"); } rlang/src/lib/squash.c0000644000176200001440000001662513242736425014404 0ustar liggesusers#include "rlang.h" #include "export.h" typedef struct { r_ssize_t size; bool named; bool warned; bool recursive; } squash_info_t; static squash_info_t squash_info_init(bool recursive) { squash_info_t info; info.size = 0; info.named = false; info.warned = false; info.recursive = recursive; return info; } // Atomic squashing --------------------------------------------------- static r_ssize_t atom_squash(enum r_type kind, squash_info_t info, sexp* outer, sexp* out, r_ssize_t count, bool (*is_spliceable)(sexp*), int depth) { if (r_typeof(outer) != VECSXP) { r_abort("Only lists can be spliced"); } sexp* inner; sexp* out_names = KEEP(r_vec_names(out)); r_ssize_t n_outer = r_length(outer); r_ssize_t n_inner; for (r_ssize_t i = 0; i != n_outer; ++i) { inner = VECTOR_ELT(outer, i); n_inner = r_vec_length(inner); if (depth != 0 && is_spliceable(inner)) { count = atom_squash(kind, info, inner, out, count, is_spliceable, depth - 1); } else if (n_inner) { r_vec_poke_coerce_n(out, count, inner, 0, n_inner); if (info.named) { sexp* nms = r_vec_names(inner); if (r_is_character(nms)) { r_vec_poke_n(out_names, count, nms, 0, n_inner); } else if (n_inner == 1 && r_has_name_at(outer, i)) { SET_STRING_ELT(out_names, count, STRING_ELT(r_vec_names(outer), i)); } } count += n_inner; } } FREE(1); return count; } // List squashing ----------------------------------------------------- static r_ssize_t list_squash(squash_info_t info, sexp* outer, sexp* out, r_ssize_t count, bool (*is_spliceable)(sexp*), int depth) { if (r_typeof(outer) != VECSXP) { r_abort("Only lists can be spliced"); } sexp* inner; sexp* out_names = KEEP(r_vec_names(out)); r_ssize_t n_outer = r_length(outer); for (r_ssize_t i = 0; i != n_outer; ++i) { inner = VECTOR_ELT(outer, i); if (depth != 0 && is_spliceable(inner)) { count = list_squash(info, inner, out, count, is_spliceable, depth - 1); } else { SET_VECTOR_ELT(out, count, inner); if (info.named && r_is_character(r_vec_names(outer))) { sexp* name = STRING_ELT(r_vec_names(outer), i); SET_STRING_ELT(out_names, count, name); } count += 1; } } FREE(1); return count; } // First pass -------------------------------------------------------- static void squash_warn_names(void) { Rf_warningcall(r_null, "Outer names are only allowed for unnamed scalar atomic inputs"); } static void update_info_outer(squash_info_t* info, sexp* outer, r_ssize_t i) { if (!info->warned && info->recursive && r_has_name_at(outer, i)) { squash_warn_names(); info->warned = true; } } static void update_info_inner(squash_info_t* info, sexp* outer, r_ssize_t i, sexp* inner) { r_ssize_t n_inner = info->recursive ? 1 : r_vec_length(inner); info->size += n_inner; // Return early if possible if (info->named && info->warned) { return; } bool named = r_is_character(r_vec_names(inner)); bool recursive = info->recursive; bool copy_outer = recursive || n_inner == 1; bool copy_inner = !recursive; if (named && copy_inner) { info->named = true; } if (r_has_name_at(outer, i)) { if (!recursive && (n_inner != 1 || named) && !info->warned) { squash_warn_names(); info->warned = true; } if (copy_outer) { info->named = true; } } } static void squash_info(squash_info_t* info, sexp* outer, bool (*is_spliceable)(sexp*), int depth) { sexp* inner; r_ssize_t n_inner; r_ssize_t n_outer = r_length(outer); for (r_ssize_t i = 0; i != n_outer; ++i) { inner = VECTOR_ELT(outer, i); n_inner = info->recursive ? 1 : r_vec_length(inner); if (depth != 0 && is_spliceable(inner)) { update_info_outer(info, outer, i); squash_info(info, inner, is_spliceable, depth - 1); } else if (n_inner) { update_info_inner(info, outer, i, inner); } } } static sexp* squash(enum r_type kind, sexp* dots, bool (*is_spliceable)(sexp*), int depth) { bool recursive = kind == VECSXP; squash_info_t info = squash_info_init(recursive); squash_info(&info, dots, is_spliceable, depth); sexp* out = KEEP(r_new_vector(kind, info.size)); if (info.named) { r_poke_names(out, r_new_vector(STRSXP, info.size)); } if (recursive) { list_squash(info, dots, out, 0, is_spliceable, depth); } else { atom_squash(kind, info, dots, out, 0, is_spliceable, depth); } FREE(1); return out; } // Predicates -------------------------------------------------------- typedef bool (*is_spliceable_t)(sexp*); bool r_is_spliced_bare(sexp* x) { return r_is_list(x) && (!r_is_object(x) || Rf_inherits(x, "spliced")); } bool r_is_spliced(sexp* x) { return r_is_list(x) && Rf_inherits(x, "spliced"); } static is_spliceable_t predicate_pointer(sexp* x) { switch (r_typeof(x)) { case VECSXP: if (Rf_inherits(x, "fn_pointer") && r_length(x) == 1) { sexp* ptr = VECTOR_ELT(x, 0); if (r_typeof(ptr) == EXTPTRSXP) { return (is_spliceable_t) R_ExternalPtrAddrFn(ptr); } } break; case EXTPTRSXP: return (is_spliceable_t) R_ExternalPtrAddrFn(x); default: break; } r_abort("`predicate` must be a closure or function pointer"); return NULL; } static is_spliceable_t predicate_internal(sexp* x) { static sexp* is_spliced_clo = NULL; if (!is_spliced_clo) { is_spliced_clo = rlang_ns_get("is_spliced"); } static sexp* is_spliceable_clo = NULL; if (!is_spliceable_clo) { is_spliceable_clo = rlang_ns_get("is_spliced_bare"); } if (x == is_spliced_clo) { return &r_is_spliced; } if (x == is_spliceable_clo) { return &r_is_spliced_bare; } return NULL; } // Emulate closure behaviour with global variable. static sexp* clo_spliceable = NULL; static bool is_spliceable_closure(sexp* x) { if (!clo_spliceable) { r_abort("Internal error while splicing"); } SETCADR(clo_spliceable, x); sexp* out = r_eval(clo_spliceable, R_GlobalEnv); return r_as_bool(out); } // Export ------------------------------------------------------------ sexp* r_squash_if(sexp* dots, enum r_type kind, bool (*is_spliceable)(sexp*), int depth) { switch (kind) { case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: case VECSXP: return squash(kind, dots, is_spliceable, depth); default: r_abort("Splicing is not implemented for this type"); return r_null; } } sexp* rlang_squash_closure(sexp* dots, enum r_type kind, sexp* pred, int depth) { sexp* prev_pred = clo_spliceable; clo_spliceable = KEEP(Rf_lang2(pred, Rf_list2(r_null, r_null))); sexp* out = r_squash_if(dots, kind, &is_spliceable_closure, depth); clo_spliceable = prev_pred; FREE(1); return out; } sexp* rlang_squash(sexp* dots, sexp* type, sexp* pred, sexp* depth_) { enum r_type kind = Rf_str2type(CHAR(STRING_ELT(type, 0))); int depth = Rf_asInteger(depth_); is_spliceable_t is_spliceable; if (r_typeof(pred) == CLOSXP) { is_spliceable = predicate_internal(pred); if (is_spliceable) { return r_squash_if(dots, kind, is_spliceable, depth); } else { return rlang_squash_closure(dots, kind, pred, depth); } } is_spliceable = predicate_pointer(pred); return r_squash_if(dots, kind, is_spliceable, depth); } rlang/src/lib/stack.h0000644000176200001440000000041513242736425014200 0ustar liggesusers#ifndef RLANG_STACK_H #define RLANG_STACK_H void r_on_exit(sexp* expr, sexp* frame); sexp* r_current_frame(); sexp* r_sys_frame(int n, sexp* frame); sexp* r_sys_call(int n, sexp* frame); static inline void r_maybe_interrupt() { R_CheckUserInterrupt(); } #endif rlang/src/lib/vec-lgl.h0000644000176200001440000000022713242736425014425 0ustar liggesusers#ifndef RLANG_VECTOR_LGL_H #define RLANG_VECTOR_LGL_H bool r_as_bool(sexp* x); int r_as_optional_bool(sexp* lgl); bool r_is_true(sexp* x); #endif rlang/src/lib/vec.h0000644000176200001440000000510313242736425013647 0ustar liggesusers#ifndef RLANG_VECTOR_H #define RLANG_VECTOR_H r_ssize_t r_vec_length(sexp* x); static inline int* r_lgl_deref(sexp* x) { return LOGICAL(x); } static inline int* r_int_deref(sexp* x) { return INTEGER(x); } static inline double* r_dbl_deref(sexp* x) { return REAL(x); } static inline r_complex_t* r_cpl_deref(sexp* x) { return COMPLEX(x); } static inline r_byte_t* r_raw_deref(sexp* x) { return RAW(x); } static inline int r_lgl_get(sexp* x, r_ssize_t i) { return LOGICAL(x)[i]; } static inline int r_int_get(sexp* x, r_ssize_t i) { return INTEGER(x)[i]; } static inline double r_dbl_get(sexp* x, r_ssize_t i) { return REAL(x)[i]; } static inline r_complex_t r_cpl_get(sexp* x, r_ssize_t i) { return COMPLEX(x)[i]; } static inline r_byte_t r_raw_get(sexp* x, r_ssize_t i) { return RAW(x)[i]; } sexp* r_vec_get(sexp* vec, r_ssize_t i); bool r_is_list(sexp* x); bool r_is_vector(sexp* x); bool r_is_scalar_atomic(sexp* x); bool r_is_atomic(sexp* x); bool r_is_integerish(sexp* x); static inline bool r_is_scalar_character(sexp* x) { return r_typeof(x) == r_type_character && r_length(x) == 1; } static inline bool r_is_scalar_logical(sexp* x) { return r_typeof(x) == r_type_logical && r_length(x) == 1; } static inline sexp* r_scalar_lgl(bool x) { return Rf_ScalarLogical(x); } static inline sexp* r_scalar_int(int x) { return Rf_ScalarInteger(x); } static inline int r_c_int(sexp* x) { return INTEGER(x)[0]; } static inline sexp* r_new_vector(enum r_type type, r_ssize_t n) { return Rf_allocVector(type, n); } static inline sexp* r_vec_coerce(sexp* x, enum r_type to) { return Rf_coerceVector(x, to); } void r_vec_poke_n(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t n); void r_vec_poke_range(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t to); void r_vec_poke_coerce_n(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t n); void r_vec_poke_coerce_range(sexp* x, r_ssize_t offset, sexp* y, r_ssize_t from, r_ssize_t to); static inline bool r_vec_find_first_duplicate(sexp* x, sexp* except, r_long_ssize_t* index) { r_long_ssize_t idx; if (except) { idx = Rf_any_duplicated3(x, except, false); } else { idx = Rf_any_duplicated(x, false); } if (idx) { if (index) { *index = idx - 1; } return true; } else { return false; } } static inline sexp* r_vec_are_duplicated(sexp* x) { return Rf_duplicated(x, false); } bool r_vec_find_first_identical_any(sexp* x, sexp* y, r_long_ssize_t* index); #endif rlang/src/lib/quo.h0000644000176200001440000000036413242736425013702 0ustar liggesusers#ifndef RLANG_QUO_H #define RLANG_QUO_H extern sexp* (*r_quo_get_expr)(sexp* quo); extern sexp* (*r_quo_set_expr)(sexp* quo, sexp* expr); extern sexp* (*r_quo_get_env)(sexp* quo); extern sexp* (*r_quo_set_env)(sexp* quo, sexp* env); #endif rlang/src/lib/export.h0000644000176200001440000000166713242736425014426 0ustar liggesusers#ifndef RLANG_EXPORT_H #define RLANG_EXPORT_H #include #include #if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0)) typedef union {void* p; DL_FUNC fn;} fn_ptr; sexp* R_MakeExternalPtrFn(DL_FUNC p, sexp* tag, sexp* prot); DL_FUNC R_ExternalPtrAddrFn(sexp* s); #endif typedef DL_FUNC r_fn_ptr_t; typedef R_CallMethodDef r_callable; typedef DllInfo r_dll_info; void rlang_register_pointer(const char* ns, const char* ptr_name, DL_FUNC fn); static inline void r_register_c_callable(const char* pkg, const char* ptr_name, r_fn_ptr_t fn) { R_RegisterCCallable(pkg, ptr_name, fn); } static inline void r_register_r_callables(r_dll_info* dll, const r_callable* const callables) { R_registerRoutines(dll, NULL, callables, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } static inline r_fn_ptr_t r_peek_c_callable(const char* pkg, const char* callable) { return R_GetCCallable(pkg, callable); } #endif rlang/src/lib/fn.h0000644000176200001440000000042213242736425013474 0ustar liggesusers#ifndef RLANG_FN_H #define RLANG_FN_H static inline sexp* r_fn_body(sexp* fn) { return BODY_EXPR(fn); } static inline sexp* r_fn_poke_body(sexp* fn, sexp* body) { SET_BODY(fn, body); return fn; } sexp* r_new_function(sexp* formals, sexp* body, sexp* env); #endif rlang/src/lib/vec-lgl.c0000644000176200001440000000073713242736425014426 0ustar liggesusers#include "rlang.h" bool r_as_bool(sexp* x) { if (r_typeof(x) != LGLSXP && r_length(x) != 1) { r_abort("Expected a scalar logical"); } int* xp = (int*) LOGICAL(x); return *xp; } int r_as_optional_bool(sexp* lgl) { if (lgl == r_null) { return -1; } else { return r_as_bool(lgl); } } bool r_is_true(sexp* x) { if (!r_is_scalar_logical(x)) { return false; } else { int value = LOGICAL(x)[0]; return value == NA_LOGICAL ? 0 : value; } } rlang/src/lib/node.c0000644000176200001440000000121513242736425014012 0ustar liggesusers#include "rlang.h" sexp* r_new_tagged_node(const char* tag, sexp* car, sexp* cdr) { sexp* node = KEEP(r_new_node(car, cdr)); r_node_poke_tag(node, r_sym(tag)); FREE(1); return node; } // Shallow copy of a node tree sexp* r_node_tree_clone(sexp* x) { if (r_typeof(x) != r_type_pairlist) { r_abort("Internal error: Expected node tree for shallow copy"); } x = KEEP(r_duplicate(x, true)); sexp* rest = x; while (rest != r_null) { sexp* head = r_node_car(rest); if (r_typeof(head) == r_type_pairlist) { r_node_poke_car(rest, r_node_tree_clone(head)); } rest = r_node_cdr(rest); } FREE(1); return x; } rlang/src/lib/sym-unescape.c0000644000176200001440000001014513242736425015500 0ustar liggesusers#include "rlang.h" #include #include #include // Interface functions --------------------------------------------------------- void copy_character(sexp* tgt, sexp* src, R_xlen_t len); R_xlen_t unescape_character_in_copy(sexp* tgt, sexp* src, R_xlen_t i); sexp* rlang_symbol(sexp* chr) { sexp* string = STRING_ELT(chr, 0); return r_sym(Rf_translateChar(string)); } sexp* rlang_symbol_to_character(sexp* chr) { sexp* name = PRINTNAME(chr); return Rf_ScalarString(r_str_unserialise_unicode(name)); } sexp* rlang_unescape_character(sexp* chr) { R_xlen_t len = Rf_xlength(chr); R_xlen_t i = unescape_character_in_copy(r_null, chr, 0); if (i == len) return chr; sexp* ret = KEEP(r_new_vector(STRSXP, len)); copy_character(ret, chr, i); unescape_character_in_copy(ret, chr, i); FREE(1); return ret; } // Private functions ----------------------------------------------------------- static sexp* unescape_char_to_sexp(char* tmp); static bool has_unicode_escape(const char* chr); static int unescape_char(char* chr); static int unescape_char_found(char* chr); static int process_byte(char* tgt, char* const src, int* len_processed); static bool has_codepoint(const char* src); static bool is_hex(const char chr); void copy_character(sexp* tgt, sexp* src, R_xlen_t len) { for (int i = 0; i < len; ++i) { SET_STRING_ELT(tgt, i, STRING_ELT(src, i)); } } R_xlen_t unescape_character_in_copy(sexp* tgt, sexp* src, R_xlen_t i) { R_xlen_t len = r_length(src); int dry_run = Rf_isNull(tgt); for (; i < len; ++i) { sexp* old_elt = STRING_ELT(src, i); sexp* new_elt = r_str_unserialise_unicode(old_elt); if (dry_run) { if (old_elt != new_elt) return i; } else { SET_STRING_ELT(tgt, i, new_elt); } } return i; } sexp* r_str_unserialise_unicode(sexp* r_string) { int ce = Rf_getCharCE(r_string); const char* src = CHAR(r_string); if (!has_unicode_escape(src)) { return r_string; } const char* re_enc = Rf_reEnc(src, ce, CE_UTF8, 0); if (re_enc == src) { // The string was not copied because we're in a UTF-8 locale. // Need to check first if the string has any UTF-8 escapes. int orig_len = strlen(re_enc); char tmp[orig_len + 1]; memcpy(tmp, re_enc, orig_len + 1); return unescape_char_to_sexp(tmp); } else { // The string has been copied so it's safe to use as buffer char* tmp = (char*)re_enc; return unescape_char_to_sexp(tmp); } } static sexp* unescape_char_to_sexp(char* tmp) { int len = unescape_char(tmp); return Rf_mkCharLenCE(tmp, len, CE_UTF8); } static bool has_unicode_escape(const char* chr) { while (*chr) { if (has_codepoint(chr)) { return true; } ++chr; } return false; } static int unescape_char(char* chr) { int len = 0; while (*chr) { if (has_codepoint(chr)) { return len + unescape_char_found(chr); } else { ++chr; ++len; } } return len; } static int unescape_char_found(char* chr) { char* source = chr; char* target = chr; int len = 0; while (*source) { int len_processed; int len_new = process_byte(target, source, &len_processed); source += len_processed; target += len_new; len += len_new; } *target = 0; return len; } static int process_byte(char* tgt, char* const src, int* len_processed) { if (!has_codepoint(src)) { // Copy only the first character (angle bracket or not), advance *tgt = *src; *len_processed = 1; return 1; } unsigned int codepoint = strtoul(src + strlen(""); // We have 8 bytes space, codepoints occupy less than that: return (int)Rf_ucstoutf8(tgt, codepoint); } static bool has_codepoint(const char* src) { if (src[0] != '<') return false; if (src[1] != 'U') return false; if (src[2] != '+') return false; for (int i = 3; i < 7; ++i) { if (!is_hex(src[i])) return false; } if (src[7] != '>') return false; return true; } static bool is_hex(const char chr) { if (chr >= '0' && chr <= '9') return true; if (chr >= 'A' && chr <= 'F') return true; return false; } rlang/src/lib/parse.c0000644000176200001440000003023613242736425014204 0ustar liggesusers#include "rlang.h" const struct r_op_precedence r_ops_precedence[R_OP_MAX] = { [R_OP_NONE] = { .power = 0, .assoc = 0, .unary = false, .delimited = false }, [R_OP_FUNCTION] = { .power = 5, .assoc = 1, .unary = true, .delimited = false }, [R_OP_QUESTION] = { .power = 10, .assoc = -1, .unary = false, .delimited = false }, [R_OP_QUESTION_UNARY] = { .power = 10, .assoc = -1, .unary = true, .delimited = false }, [R_OP_WHILE] = { .power = 20, .assoc = -1, .unary = false, .delimited = true }, [R_OP_FOR] = { .power = 20, .assoc = -1, .unary = false, .delimited = true }, [R_OP_REPEAT] = { .power = 20, .assoc = -1, .unary = false, .delimited = true }, [R_OP_IF] = { .power = 30, .assoc = 1, .unary = false, .delimited = true }, [R_OP_ASSIGN1] = { .power = 40, .assoc = 1, .unary = false, .delimited = false }, [R_OP_ASSIGN2] = { .power = 40, .assoc = 1, .unary = false, .delimited = false }, [R_OP_COLON_EQUAL] = { .power = 40, .assoc = 1, .unary = false, .delimited = false }, [R_OP_ASSIGN_EQUAL] = { .power = 50, .assoc = 1, .unary = false, .delimited = false }, [R_OP_TILDE] = { .power = 60, .assoc = -1, .unary = false, .delimited = false }, [R_OP_TILDE_UNARY] = { .power = 60, .assoc = -1, .unary = true, .delimited = false }, [R_OP_OR1] = { .power = 70, .assoc = -1, .unary = false, .delimited = false }, [R_OP_OR2] = { .power = 70, .assoc = -1, .unary = false, .delimited = false }, [R_OP_AND1] = { .power = 80, .assoc = -1, .unary = false, .delimited = false }, [R_OP_AND2] = { .power = 80, .assoc = -1, .unary = false, .delimited = false }, [R_OP_BANG1] = { .power = 90, .assoc = -1, .unary = true, .delimited = false }, [R_OP_BANG3] = { .power = 90, .assoc = -1, .unary = true, .delimited = false }, [R_OP_GREATER] = { .power = 100, .assoc = 0, .unary = false, .delimited = false }, [R_OP_GREATER_EQUAL] = { .power = 100, .assoc = 0, .unary = false, .delimited = false }, [R_OP_LESS] = { .power = 100, .assoc = 0, .unary = false, .delimited = false }, [R_OP_LESS_EQUAL] = { .power = 100, .assoc = 0, .unary = false, .delimited = false }, [R_OP_EQUAL] = { .power = 100, .assoc = 0, .unary = false, .delimited = false }, [R_OP_NOT_EQUAL] = { .power = 100, .assoc = 0, .unary = false, .delimited = false }, [R_OP_PLUS] = { .power = 110, .assoc = -1, .unary = false, .delimited = false }, [R_OP_MINUS] = { .power = 110, .assoc = -1, .unary = false, .delimited = false }, [R_OP_TIMES] = { .power = 120, .assoc = -1, .unary = false, .delimited = false }, [R_OP_RATIO] = { .power = 120, .assoc = -1, .unary = false, .delimited = false }, [R_OP_MODULO] = { .power = 130, .assoc = -1, .unary = false, .delimited = false }, [R_OP_SPECIAL] = { .power = 130, .assoc = -1, .unary = false, .delimited = false }, [R_OP_COLON1] = { .power = 140, .assoc = -1, .unary = false, .delimited = false }, [R_OP_BANG2] = { .power = 150, .assoc = -1, .unary = true, .delimited = false }, [R_OP_PLUS_UNARY] = { .power = 150, .assoc = -1, .unary = true, .delimited = false }, [R_OP_MINUS_UNARY] = { .power = 150, .assoc = -1, .unary = true, .delimited = false }, [R_OP_HAT] = { .power = 160, .assoc = 1, .unary = false, .delimited = false }, [R_OP_DOLLAR] = { .power = 170, .assoc = -1, .unary = false, .delimited = false }, [R_OP_AT] = { .power = 170, .assoc = -1, .unary = false, .delimited = false }, [R_OP_COLON2] = { .power = 180, .assoc = 0, .unary = false, .delimited = false }, [R_OP_COLON3] = { .power = 180, .assoc = 0, .unary = false, .delimited = false }, [R_OP_PARENTHESES] = { .power = 190, .assoc = 0, .unary = true, .delimited = true }, [R_OP_BRACKETS1] = { .power = 190, .assoc = -1, .unary = false, .delimited = false }, [R_OP_BRACKETS2] = { .power = 190, .assoc = -1, .unary = false, .delimited = false }, [R_OP_BRACES] = { .power = 200, .assoc = 0, .unary = false, .delimited = true } }; enum r_operator r_which_operator(sexp* call) { if (r_typeof(call) != r_type_call) { return R_OP_NONE; } sexp* head = r_node_car(call); if (r_typeof(head) != r_type_symbol) { return R_OP_NONE; } const char* name = r_sym_c_str(head); size_t len = strlen(name); bool is_unary = r_node_cddr(call) == r_null; switch (name[0]) { case 'w': if (strcmp(name, "while") == 0) { return R_OP_WHILE; } else { goto none; } case 'f': if (strcmp(name, "for") == 0) { return R_OP_FOR; } else if (strcmp(name, "function") == 0) { return R_OP_FUNCTION; } else { goto none; } case 'r': if (strcmp(name, "repeat") == 0) { return R_OP_REPEAT; } else { goto none; } case 'i': if (strcmp(name, "if") == 0) { return R_OP_IF; } else { goto none; } case '?': if (len == 1) { if (is_unary) { return R_OP_QUESTION_UNARY; } else { return R_OP_QUESTION; } } else { goto none; } case '<': switch (len) { case 1: return R_OP_LESS; case 2: switch (name[1]) { case '-': return R_OP_ASSIGN1; case '=': return R_OP_LESS_EQUAL; default: goto none; } case 3: if (name[1] == '<' && name[2] == '-') { return R_OP_ASSIGN2; } else { goto none; } default: goto none; } case '>': switch (len) { case 1: return R_OP_GREATER; case 2: if (name[1] == '=') { return R_OP_GREATER_EQUAL; } else { goto none; } default: goto none; } case '=': switch (len) { case 1: return R_OP_ASSIGN_EQUAL; case 2: if (name[1] == '=') { return R_OP_EQUAL; } else { goto none; } default: goto none; } case ':': switch (len) { case 1: return R_OP_COLON1; case 2: switch (name[1]) { case '=': return R_OP_COLON_EQUAL; case ':': return R_OP_COLON2; default: goto none; } case 3: if (name[1] == ':' && name[2] == ':') { return R_OP_COLON3; } else { goto none; } default: goto none; } case '~': if (len == 1) { if (is_unary) { return R_OP_TILDE_UNARY; } else { return R_OP_TILDE; } } else { goto none; } case '|': switch (len) { case 1: return R_OP_OR1; case 2: if (name[1] == '|') { return R_OP_OR2; } else { goto none; } default: goto none; } case '&': switch (len) { case 1: return R_OP_AND1; case 2: if (name[1] == '&') { return R_OP_AND2; } else { goto none; } default: goto none; } case '!': switch (len) { case 1: return R_OP_BANG1; case 2: switch (name[1]) { case '!': return R_OP_BANG2; case '=': return R_OP_NOT_EQUAL; default: goto none; } case 3: if (name[1] == '!' && name[2] == '!') { return R_OP_BANG3; } else { goto none; } default: goto none; } case '+': if (len == 1) { if (is_unary) { return R_OP_PLUS_UNARY; } else { return R_OP_PLUS; } } else { goto none; } case '-': if (len == 1) { if (is_unary) { return R_OP_MINUS_UNARY; } else { return R_OP_MINUS; } } else { goto none; } case '*': if (len == 1) { return R_OP_TIMES; } else { goto none; } case '/': if (len == 1) { return R_OP_RATIO; } else { goto none; } case '%': switch (len) { case 1: goto none; case 2: if (name[1] == '%') { return R_OP_MODULO; } else { goto none; } default: if (name[len - 1] == '%') { return R_OP_SPECIAL; } else { goto none; } } case '^': if (len == 1) { return R_OP_HAT; } else { goto none; } case '$': if (len == 1) { return R_OP_DOLLAR; } else { goto none; } case '@': if (len == 1) { return R_OP_AT; } else { goto none; } case '(': if (len == 1) { return R_OP_PARENTHESES; } else { goto none; } case '[': switch (len) { case 1: return R_OP_BRACKETS1; case 2: if (name[1] == '[') { return R_OP_BRACKETS2; } else { goto none; } default: goto none; } case '{': if (len == 1) { return R_OP_BRACES; } else { goto none; } none: default: return R_OP_NONE; } } const char* r_op_as_c_string(enum r_operator op) { switch (op) { case R_OP_NONE: return ""; case R_OP_WHILE: return "while"; case R_OP_FOR: return "for"; case R_OP_REPEAT: return "repeat"; case R_OP_IF: return "if"; case R_OP_FUNCTION: return "function"; case R_OP_QUESTION: return "?"; case R_OP_QUESTION_UNARY: return "?unary"; case R_OP_ASSIGN1: return "<-"; case R_OP_ASSIGN2: return "<<-"; case R_OP_ASSIGN_EQUAL: return "="; case R_OP_COLON_EQUAL: return ":="; case R_OP_TILDE: return "~"; case R_OP_TILDE_UNARY: return "~unary"; case R_OP_OR1: return "|"; case R_OP_OR2: return "||"; case R_OP_AND1: return "&"; case R_OP_AND2: return "&&"; case R_OP_BANG1: return "!"; case R_OP_BANG3: return "!!!"; case R_OP_GREATER: return ">"; case R_OP_GREATER_EQUAL: return ">="; case R_OP_LESS: return "<"; case R_OP_LESS_EQUAL: return "<="; case R_OP_EQUAL: return "=="; case R_OP_NOT_EQUAL: return "!="; case R_OP_PLUS: return "+"; case R_OP_MINUS: return "-"; case R_OP_TIMES: return "*"; case R_OP_RATIO: return "/"; case R_OP_MODULO: return "%%"; case R_OP_SPECIAL: return "special"; case R_OP_COLON1: return ":"; case R_OP_BANG2: return "!!"; case R_OP_PLUS_UNARY: return "+unary"; case R_OP_MINUS_UNARY: return "-unary"; case R_OP_HAT: return "^"; case R_OP_DOLLAR: return "$"; case R_OP_AT: return "@"; case R_OP_COLON2: return "::"; case R_OP_COLON3: return ":::"; case R_OP_PARENTHESES: return "("; case R_OP_BRACKETS1: return "["; case R_OP_BRACKETS2: return "[["; case R_OP_BRACES: return "{"; case R_OP_MAX: r_abort("Unexpected `enum r_operator` value"); } // Silence mistaken noreturn warning on GCC r_abort("Never reached"); } bool op_has_precedence_impl(enum r_operator x, enum r_operator parent, int side) { if (x > R_OP_MAX || parent > R_OP_MAX) { r_abort("Internal error: `enum r_operator` out of bounds"); } if (x == R_OP_NONE) { return true; } if (parent == R_OP_NONE) { return true; } struct r_op_precedence x_info = r_ops_precedence[x]; struct r_op_precedence y_info = r_ops_precedence[parent]; if (x_info.delimited) { return true; } if (y_info.delimited) { return false; } uint8_t x_power = x_info.power; uint8_t y_power = y_info.power; if (x_power == y_power) { if (side == 0) { r_abort("Internal error: Unspecified direction of associativity"); } return r_ops_precedence[x].assoc == side; } else { return x_power > y_power; } } bool r_op_has_precedence(enum r_operator x, enum r_operator parent) { return op_has_precedence_impl(x, parent, 0); } bool r_lhs_op_has_precedence(enum r_operator lhs, enum r_operator parent) { return op_has_precedence_impl(lhs, parent, -1); } bool r_rhs_op_has_precedence(enum r_operator rhs, enum r_operator parent) { return op_has_precedence_impl(rhs, parent, 1); } rlang/src/internal/0000755000176200001440000000000013242771563013772 5ustar liggesusersrlang/src/internal/dots.c0000644000176200001440000003433213242736425015112 0ustar liggesusers#include #include "dots.h" #include "expr-interp.h" #include "utils.h" sexp* rlang_ns_get(const char* name); struct dots_capture_info { enum dots_capture_type type; r_ssize_t count; sexp* named; bool needs_expansion; int ignore_empty; bool unquote_names; }; static int match_ignore_empty_arg(sexp* ignore_empty); static int find_auto_names_width(sexp* named); struct dots_capture_info init_capture_info(enum dots_capture_type type, sexp* named, sexp* ignore_empty, sexp* unquote_names) { struct dots_capture_info info; info.type = type; info.count = 0; info.needs_expansion = false; info.named = named; info.ignore_empty = match_ignore_empty_arg(ignore_empty); info.unquote_names = r_as_bool(unquote_names); return info; } static sexp* def_unquote_name(sexp* expr, sexp* env) { int n_kept = 0; sexp* lhs = r_node_cadr(expr); struct expansion_info info = which_expansion_op(lhs, true); switch (info.op) { case OP_EXPAND_NONE: break; case OP_EXPAND_UQ: lhs = KEEP_N(r_eval(info.operand, env), n_kept); break; case OP_EXPAND_UQE: r_abort("The LHS of `:=` can't be unquoted with `UQE()`"); case OP_EXPAND_UQS: r_abort("The LHS of `:=` can't be spliced with `!!!`"); case OP_EXPAND_UQN: r_abort("Internal error: Chained `:=` should have been detected earlier"); case OP_EXPAND_FIXUP: r_abort("The LHS of `:=` must be a string or a symbol"); } int err = 0; lhs = r_new_symbol(lhs, &err); if (err) { r_abort("The LHS of `:=` must be a string or a symbol"); } sexp* name = r_sym_str(lhs); // Unserialise unicode points such as that arise when // UTF-8 names are converted to symbols and the native encoding // does not support the characters (i.e. all the time on Windows) name = r_str_unserialise_unicode(name); FREE(n_kept); return name; } static sexp* rlang_spliced_flag = NULL; static inline bool is_spliced_dots(sexp* x) { return r_get_attribute(x, rlang_spliced_flag) != r_null; } static inline void mark_spliced_dots(sexp* x) { r_poke_attribute(x, rlang_spliced_flag, rlang_spliced_flag); } static sexp* dots_big_bang_coerce(sexp* expr) { switch (r_typeof(expr)) { case r_type_null: case r_type_pairlist: case r_type_logical: case r_type_integer: case r_type_double: case r_type_complex: case r_type_character: case r_type_raw: return r_vec_coerce(expr, r_type_list); case r_type_list: return r_duplicate(expr, true); case r_type_call: if (r_is_symbol(r_node_car(expr), "{")) { return r_vec_coerce(r_node_cdr(expr), r_type_list); } // else fallthrough default: return r_new_list(expr, NULL); } } static sexp* dots_big_bang(struct dots_capture_info* capture_info, sexp* expr, sexp* env, bool quosured) { sexp* value = KEEP(r_eval(expr, env)); value = KEEP(dots_big_bang_coerce(value)); mark_spliced_dots(value); r_ssize_t n = r_length(value); capture_info->count += n; if (quosured) { for (r_ssize_t i = 0; i < n; ++i) { expr = r_list_get(value, i); expr = forward_quosure(expr, env); r_list_poke(value, i, expr); } } FREE(2); return value; } static sexp* set_value_spliced(sexp* x) { static sexp* spliced_str = NULL; if (!spliced_str) { spliced_str = r_scalar_chr("spliced"); r_mark_precious(spliced_str); r_mark_shared(spliced_str); } if (r_typeof(x) != r_type_list) { r_abort("Can't use `!!!` on atomic vectors in non-quoting functions"); } return r_set_attribute(x, r_class_sym, spliced_str); } static inline bool should_ignore(int ignore_empty, r_ssize_t i, r_ssize_t n) { return ignore_empty == 1 || (i == n - 1 && ignore_empty == -1); } static inline sexp* dot_get_expr(sexp* dot) { return r_list_get(dot, 0); } static inline sexp* dot_get_env(sexp* dot) { return r_list_get(dot, 1); } static sexp* empty_spliced_list() { static sexp* list = NULL; if (!list) { list = new_preserved_empty_list(); mark_spliced_dots(list); } return list; } static sexp* dots_unquote(sexp* dots, struct dots_capture_info* capture_info) { if (!rlang_spliced_flag) rlang_spliced_flag = r_sym("__rlang_spliced"); sexp* dots_names = r_vec_names(dots); capture_info->count = 0; r_ssize_t n = r_length(dots); bool unquote_names = capture_info->unquote_names; int i_protect; KEEP_WITH_INDEX(dots_names, i_protect); for (r_ssize_t i = 0; i < n; ++i) { sexp* elt = r_list_get(dots, i); sexp* expr = dot_get_expr(elt); sexp* env = dot_get_env(elt); // Unquoting rearranges expressions expr = KEEP(r_duplicate(expr, false)); if (unquote_names && r_is_call(expr, ":=")) { sexp* name = KEEP(def_unquote_name(expr, env)); if (dots_names == r_null) { dots_names = r_new_vector(r_type_character, n); KEEP_I(dots_names, i_protect); r_push_names(dots, dots_names); } if (r_chr_has_empty_string_at(dots_names, i)) { r_chr_poke(dots_names, i, name); } else { r_abort("Can't supply both `=` and `:=`"); } expr = r_node_cadr(r_node_cdr(expr)); FREE(1); } struct expansion_info info = which_expansion_op(expr, unquote_names); enum dots_expansion_op dots_op = info.op + (EXPANSION_OP_MAX * capture_info->type); // Ignore empty arguments if (expr == r_missing_sym && (dots_names == r_null || r_chr_has_empty_string_at(dots_names, i)) && should_ignore(capture_info->ignore_empty, i, n)) { capture_info->needs_expansion = true; r_list_poke(dots, i, empty_spliced_list()); FREE(1); continue; } switch (dots_op) { case OP_EXPR_NONE: case OP_EXPR_UQ: case OP_EXPR_UQE: case OP_EXPR_FIXUP: expr = call_interp_impl(expr, env, info); capture_info->count += 1; break; case OP_EXPR_UQS: capture_info->needs_expansion = true; expr = dots_big_bang(capture_info, info.operand, env, false); // Work around bug in dplyr 0.7.4 int n = r_length(expr); for (int i = 0; i < n; ++i) { sexp* elt = r_list_get(expr, i); if (rlang_is_quosure(elt)) { r_list_poke(expr, i, rlang_quo_get_expr(elt)); } } break; case OP_QUO_NONE: case OP_QUO_UQ: case OP_QUO_UQE: case OP_QUO_FIXUP: { expr = KEEP(call_interp_impl(expr, env, info)); expr = forward_quosure(expr, env); FREE(1); capture_info->count += 1; break; } case OP_QUO_UQS: { capture_info->needs_expansion = true; expr = dots_big_bang(capture_info, info.operand, env, true); break; } case OP_VALUE_FIXUP: case OP_VALUE_NONE: if (expr == r_missing_sym) { r_abort("Argument %d is empty", i + 1); } expr = r_eval(expr, env); if (r_inherits(expr, "spliced")) { capture_info->needs_expansion = true; } capture_info->count += 1; break; case OP_VALUE_UQ: r_abort("Can't use `!!` in a non-quoting function"); case OP_VALUE_UQE: r_abort("Can't use `UQE()` in a non-quoting function"); case OP_VALUE_UQS: { expr = KEEP(r_eval(info.operand, env)); capture_info->needs_expansion = true; if (expr == r_null) { expr = empty_spliced_list(); } else { expr = set_value_spliced(expr); capture_info->count += 1; } FREE(1); break; } case OP_EXPR_UQN: case OP_QUO_UQN: case OP_VALUE_UQN: r_abort("`:=` can't be chained"); case OP_DOTS_MAX: r_abort("Internal error: `OP_DOTS_MAX`"); } r_list_poke(dots, i, expr); FREE(1); } FREE(1); return dots; } static int match_ignore_empty_arg(sexp* ignore_empty) { if (!r_is_character(ignore_empty) || r_length(ignore_empty) == 0) { r_abort("`.ignore_empty` must be a character vector"); } const char* arg = r_c_string(ignore_empty); switch(arg[0]) { case 't': if (!strcmp(arg, "trailing")) return -1; else break; case 'n': if (!strcmp(arg, "none")) return 0; else break; case 'a': if (!strcmp(arg, "all")) return 1; else break; } r_abort("`.ignore_empty` should be one of: \"trailing\", \"none\" or \"all\""); } static int find_auto_names_width(sexp* named) { if (r_length(named) != 1) { goto error; } switch (r_typeof(named)) { case r_type_logical: if (r_as_bool(named)) { return 60; } else { return 0; } case r_type_integer: return INTEGER(named)[0]; case r_type_double: if (r_is_integerish(named)) { return REAL(named)[0]; } // else fallthrough default: break; } error: r_abort("`.named` must be a scalar logical or number"); } static sexp* maybe_auto_name(sexp* x, sexp* named) { int names_width = find_auto_names_width(named); sexp* names = r_vec_names(x); if (names_width && (!names || r_chr_has(names, ""))) { sexp* auto_fn = KEEP(rlang_ns_get("quos_auto_name")); sexp* width = KEEP(r_scalar_int(names_width)); sexp* auto_call = KEEP(r_build_call2(auto_fn, x, width)); x = r_eval(auto_call, r_empty_env); FREE(3); } return x; } static sexp* init_names(sexp* x) { sexp* nms = KEEP(r_new_vector(r_type_character, r_length(x))); r_push_names(x, nms); FREE(1); return nms; } // From capture.c sexp* capturedots(sexp* frame); sexp* dots_expand(sexp* dots, struct dots_capture_info* capture_info) { sexp* dots_names = r_vec_names(dots); sexp* out = KEEP(r_new_vector(r_type_list, capture_info->count)); // Add default empty names unless dots are captured by values sexp* out_names = r_null; if (capture_info->type != DOTS_VALUE || dots_names != r_null) { out_names = init_names(out); } r_ssize_t n = r_length(dots); for (r_ssize_t i = 0, count = 0; i < n; ++i) { sexp* elt = r_list_get(dots, i); if (is_spliced_dots(elt)) { sexp* names = r_vec_names(elt); // FIXME: Should be able to avoid conversion to list for node // lists and character vectors for (r_ssize_t i = 0; i < r_length(elt); ++i) { sexp* value = r_list_get(elt, i); r_list_poke(out, count, value); sexp* name = r_nms_get(names, i); if (name != r_string("")) { // Serialised unicode points might arise when unquoting // lists because of the conversion to pairlist name = KEEP(r_str_unserialise_unicode(name)); // Names might not be initialised when dots are captured by value if (out_names == r_null) { out_names = init_names(out); } r_chr_poke(out_names, count, name); FREE(1); } ++count; } } else { r_list_poke(out, count, elt); if (dots_names != r_null) { sexp* name = r_chr_get(dots_names, i); r_chr_poke(out_names, count, name); } ++count; } } out = maybe_auto_name(out, capture_info->named); FREE(1); return out; } sexp* dots_init(struct dots_capture_info* capture_info, sexp* frame_env) { sexp* dots = KEEP(capturedots(frame_env)); dots = dots_unquote(dots, capture_info); // Initialise the names only if there is no expansion to avoid // unnecessary allocation and auto-labelling if (!capture_info->needs_expansion) { if (capture_info->type != DOTS_VALUE && r_vec_names(dots) == r_null) { init_names(dots); } dots = maybe_auto_name(dots, capture_info->named); } FREE(1); return dots; } sexp* rlang_exprs_interp(sexp* frame_env, sexp* named, sexp* ignore_empty, sexp* unquote_names) { struct dots_capture_info capture_info; capture_info = init_capture_info(DOTS_EXPR, named, ignore_empty, unquote_names); sexp* dots = dots_init(&capture_info, frame_env); if (capture_info.needs_expansion) { KEEP(dots); dots = dots_expand(dots, &capture_info); FREE(1); } return dots; } sexp* rlang_quos_interp(sexp* frame_env, sexp* named, sexp* ignore_empty, sexp* unquote_names) { int n_protect = 0; struct dots_capture_info capture_info; capture_info = init_capture_info(DOTS_QUO, named, ignore_empty, unquote_names); sexp* dots = KEEP_N(dots_init(&capture_info, frame_env), n_protect); if (capture_info.needs_expansion) { dots = dots_expand(dots, &capture_info); KEEP_N(dots, n_protect); } r_push_class(dots, "quosures"); FREE(n_protect); return dots; } static bool is_spliced_dots_value(sexp* x) { if (r_typeof(x) != r_type_list) { return false; } if (is_spliced_dots(x) || r_inherits(x, "spliced")) { return true; } return false; } static bool is_spliced_bare_dots_value(sexp* x) { if (r_typeof(x) != r_type_list) { return false; } if (is_spliced_dots(x)) { return true; } if (r_inherits(x, "spliced")) { return true; } if (r_is_object(x)) { return false; } return true; } static sexp* dots_values_impl(sexp* frame_env, sexp* named, sexp* ignore_empty, sexp* unquote_names, bool (*is_spliced)(sexp*)) { struct dots_capture_info capture_info; capture_info = init_capture_info(DOTS_VALUE, named, ignore_empty, unquote_names); sexp* dots = dots_init(&capture_info, frame_env); KEEP(dots); if (capture_info.needs_expansion) { if (is_spliced) { dots = r_squash_if(dots, r_type_list, is_spliced, 1); } else { dots = dots_expand(dots, &capture_info); } } FREE(1); return dots; } sexp* rlang_dots_values(sexp* frame_env, sexp* named, sexp* ignore_empty, sexp* unquote_names) { return dots_values_impl(frame_env, named, ignore_empty, unquote_names, NULL); } sexp* rlang_dots_list(sexp* frame_env, sexp* named, sexp* ignore_empty, sexp* unquote_names) { return dots_values_impl(frame_env, named, ignore_empty, unquote_names, is_spliced_dots_value); } sexp* rlang_dots_flat_list(sexp* frame_env, sexp* named, sexp* ignore_empty, sexp* unquote_names) { struct dots_capture_info capture_info; capture_info = init_capture_info(DOTS_VALUE, named, ignore_empty, unquote_names); sexp* dots = dots_init(&capture_info, frame_env); KEEP(dots); dots = r_squash_if(dots, r_type_list, is_spliced_bare_dots_value, 1); FREE(1); return dots; } rlang/src/internal/expr-interp.h0000644000176200001440000000355613242736425016427 0ustar liggesusers#ifndef RLANG_INTERNAL_EXPR_INTERP_H #define RLANG_INTERNAL_EXPR_INTERP_H #include "quo.h" #define UQ_N 2 #define UQE_N 1 #define UQS_N 2 static const char* uqe_names[UQE_N] = { "UQE" }; static const char* uqs_names[UQS_N] = { "UQS", "!!!"}; static inline bool is_maybe_rlang_call(sexp* x, const char* name) { return r_is_call(x, name) || r_is_namespaced_call(x, "rlang", name); } static inline bool is_maybe_rlang_call_any(sexp* x, const char** names, int n) { return r_is_call_any(x, names, n) || r_is_namespaced_call_any(x, "rlang", names, n); } static inline bool is_splice_call(sexp* node) { return is_maybe_rlang_call_any(node, uqs_names, UQS_N); } #define EXPANSION_OP_MAX 6 enum expansion_op { OP_EXPAND_NONE, OP_EXPAND_UQ, OP_EXPAND_UQE, OP_EXPAND_UQS, OP_EXPAND_UQN, OP_EXPAND_FIXUP }; struct expansion_info { enum expansion_op op; sexp* operand; sexp* parent; sexp* root; }; static inline struct expansion_info init_expansion_info() { struct expansion_info info; info.op = OP_EXPAND_NONE; info.operand = r_null; info.parent = r_null; info.root = r_null; return info; } struct expansion_info which_bang_op(sexp* x); struct expansion_info which_expansion_op(sexp* x, bool unquote_names); struct expansion_info is_big_bang_op(sexp* x); sexp* big_bang(sexp* operand, sexp* env, sexp* node, sexp* next); sexp* big_bang_coerce(sexp* expr); sexp* rlang_interp(sexp* x, sexp* env); sexp* call_interp(sexp* x, sexp* env); sexp* call_interp_impl(sexp* x, sexp* env, struct expansion_info info); static inline sexp* forward_quosure(sexp* x, sexp* env) { switch (r_typeof(x)) { case r_type_call: if (rlang_is_quosure(x)) { return x; } // else fallthrough case r_type_symbol: case r_type_closure: return rlang_new_quosure(x, env); default: return rlang_new_quosure(x, r_empty_env); } } #endif rlang/src/internal/utils.c0000644000176200001440000000070613242736425015277 0ustar liggesusers#include sexp* new_preserved_empty_list() { sexp* empty_list = r_new_vector(r_type_list, 0); r_mark_precious(empty_list); r_mark_shared(empty_list); sexp* nms = KEEP(r_new_vector(r_type_character, 0)); r_poke_names(empty_list, nms); FREE(1); return empty_list; } void signal_soft_deprecation(const char* msg) { sexp* opt = r_peek_option("lifecycle_force_verbose_retirement"); if (r_is_true(opt)) { r_warn(msg); } } rlang/src/internal/dots.h0000644000176200001440000000075013242736425015114 0ustar liggesusers#ifndef RLANG_INTERNAL_DOTS_H #define RLANG_INTERNAL_DOTS_H #define DOTS_CAPTURE_TYPE_MAX 3 enum dots_capture_type { DOTS_EXPR, DOTS_QUO, DOTS_VALUE }; enum dots_expansion_op { OP_EXPR_NONE, OP_EXPR_UQ, OP_EXPR_UQE, OP_EXPR_UQS, OP_EXPR_UQN, OP_EXPR_FIXUP, OP_QUO_NONE, OP_QUO_UQ, OP_QUO_UQE, OP_QUO_UQS, OP_QUO_UQN, OP_QUO_FIXUP, OP_VALUE_NONE, OP_VALUE_UQ, OP_VALUE_UQE, OP_VALUE_UQS, OP_VALUE_UQN, OP_VALUE_FIXUP, OP_DOTS_MAX }; #endif rlang/src/internal/expr-interp-rotate.c0000644000176200001440000004445613242736425017722 0ustar liggesusers#include #include "expr-interp.h" #include "expr-interp-rotate.h" /** * DOC: Interpolation in operator calls whose precedence might need fixup * * We want `!!` to have the precedence of unary `-` and `+` instead of * the very low precedence of `!`. To that end we need to patch the * AST to reflect the new precedence. * * Let's take `1 + 2 + 3` as a motivating example. `+` is a * left-associative operator so the expression `1 + 2` on the left is * evaluated first and it is pulled downwards in the AST: * * > 1 + 2 + 3 * * █─`+` * ├─█─`+` * │ ├─1 * │ └─2 * └─3 * * After introducing an unary operator with low precedence in the * expression we get this AST: * * > 1 + !2 + 3 * * █─`+` * ├─1 * └─█─`!` * └─█─`+` * ├─2 * └─3 * * Every binary operation on the RHS of `!` that has a higher * precedence will be evaluated before `!`. As a result the second `+` * never gets the chance of being matched to the first one, it is cut * out of the LHS of `!`. The effect of `!` on the AST is equivalent * to wrapping the problematic expression in parentheses. * * > 1 + (2 + 3) * * █─`+` * ├─1 * └─█─`(` * └─█─`+` * ├─2 * └─3 * * This is only problematic when the precedence of the `!!` operand is * lower than the precedence of its parent operation. If it is higher, * the implicit grouping is the same as the one produced by `!`: * * > ast(1 + 2 * 3) // Implicit grouping * * █─`+` * ├─1 * └─█─`* * ├─2 * └─3 * * > ast(1 + !2 * 3) // `!` grouping * * █─`+` * ├─1 * └─█─`!` * └─█─`* * ├─2 * └─3 * * If the precedence of `!`'s operand is lower the R parser will * unduly pull it downward in the AST. We can fix that by swapping the * operand with the parent node of `!`. In addition the LHS of the * operand (e.g. `2`) must become the RHS of the expression it was cut * off from. It turns out that these two operations amount to a [tree * rotation](https://en.wikipedia.org/wiki/Tree_rotation). The parent * node of `!` is the root (or rotator) and the `!` operand is the * pivot. We also need to take care of the actual expression that * needs to be unquoted, which we will call "target": * * > 1 + !!2 + 3 * * █─`+` // root * ├─1 * └─█─`!` * └─█─`!` * └─█─`+` // pivot * ├─2 // target * └─3 * * Notice from the diagrams above that the leaves of the AST have the * same ordering no matter the operation precedence. When we patch up * the AST we only change the structure of the tree not the ordering * of the leaves. Tree rotation adequately preserves the ordering of * the leaves (which is why it useful for balancing ordered binary * trees). * * The rotation algorithm roughly goes as follows: * * - The `!!` target is unquoted and replaced with the unquoted value. * - The RHS of the root is attached to the LHS of the pivot. * - The LHS of the pivot is attached to the root. * - The root's parent is reattached to the pivot. * * The full story is a bit more complicated when complex expressions * are involved. There are three main complications. First the target * might not be a child of the pivot. Let's take this expression: * * > 1 + 2 * 3 + 4 * * █─`+` * ├─█─`+` * │ ├─1 * │ └─█─`*` * │ ├─2 * │ └─3 * └─4 * * and assume we want to unquote `2`: * * > 1 + !!2 * 3 + 4 * * █─`+` // root * ├─1 * └─█─`!` * └─█─`!` * └─█─`+` // pivot * ├─█─`*` * │ ├─2 // target * │ └─3 * └─4 * * The `*` call is not a pivot because it has higher precedence than * the root `+`. Instead the pivot is the second `+` call. However * `!!` has higher precedence than `*` so the target to unquote is * deeper than the LHS of the pivot. In this case it is the LHS of the * LHS (it might be deeper but always across LHS's). * * Another source of complication is that we might need to rotate * entire subsets of the AST. First the pivot might comprise several * expressions. In this case we distinguish the lower pivot as the * node whose LHS is attached to the root and the upper pivot which * becomes the new root after rotation. This complication arises when * the `!!` operand is a succession of operations with decreasing * precedence (which is the case for left-associative operators with * the same precedence). * * > 1 + 2 + 3 + 4 + 5 * * █─`+` * ├─█─`+` * │ ├─█─`+` * │ │ ├─█─`+` * │ │ │ ├─1 * │ │ │ └─2 * │ │ └─3 * │ └─4 * └─5 * * > 1 + !!2 + 3 + 4 + 5 * * █─`+` // root * ├─1 * └─█─`!` * └─█─`!` * └─█─`+` // upper pivot * ├─█─`+` * │ ├─█─`+` // lower pivot * │ │ ├─2 // target * │ │ └─3 * │ └─4 * └─5 * * Finally the root might also comprise several expressions. In the * following example we see an upper root (which becomes the pivot's * or lower pivot's LHS) and a lower root (whose RHS is attached to * the pivot's or lower pivot's LHS). This complication happens when * the operations before `!!` have increasing levels of precedence: * * > 1 + 2 * 3 + 4 * * █─`+` * ├─█─`+` * │ ├─1 * │ └─█─`*` * │ ├─2 * │ └─3 * └─4 * * > 1 + 2 * !!3 + 4 * * █─`+` // upper root * ├─1 * └─█─`*` // lower root * ├─2 * └─█─`!` * └─█─`!` * └─█─`+` // pivot * ├─3 // target * └─4 * * These three complications (deep target, root, and pivot) may arise * in conjunction. * * In addition we also need to deal with multiple `!!` calls in a * series of binary operations. This is handled by recursing from the * upper pivot (the new root) after rotation. Finally the possibility * of intervening unary `+` or `-` operations also needs special * handling. * * All operators whose precedence lies between prec(`!`) and * prec(`!!`) might be involved in such a fixup of the AST. We call * these the "problematic" operators. Since the root can be multiple * expressions deep, we can't tell in advance whether the current * operation in the AST is involved in a rotation. Hence we apply * node_list_interp_fixup() instead of node_list_interp() whenever we * reach a problematic operator. */ bool op_is_unary(enum r_operator op) { if (op == R_OP_NONE || op > R_OP_MAX) { r_abort("Internal error: `enum r_operator` out of bounds"); } return r_ops_precedence[op].unary; } bool is_unary(sexp* x) { return op_is_unary(r_which_operator(x)); } bool op_is_unary_plusminus(enum r_operator op) { switch (op) { case R_OP_PLUS_UNARY: case R_OP_MINUS_UNARY: return true; default: return false; } } bool is_unary_plusminus(sexp* x) { return op_is_unary_plusminus(r_which_operator(x)); } /** * struct ast_rotation_info - Rotation data gathered while recursing over AST * * @upper_pivot_op: The operation type of the upper pivot. * @upper_pivot: The expression that becomes the new root after rotation. * @lower_pivot: The expression whose LHS is attached to @upper_root. * @upper_root: The expression that becomes the LHS of @lower_pivot. * @lower_root: The expression whose RHS is attached to the LHS of @lower_pivot. * @root_parent: Node whose CAR should be reattached to @upper_pivot * after rotation. */ struct ast_rotation_info { enum r_operator upper_pivot_op; sexp* upper_pivot; sexp* lower_pivot; sexp* upper_root; sexp* lower_root; sexp* root_parent; }; static void initialise_rotation_info(struct ast_rotation_info* info) { info->upper_pivot_op = R_OP_NONE; info->upper_pivot = NULL; info->lower_pivot = NULL; info->upper_root = NULL; info->lower_root = NULL; info->root_parent = NULL; } // Defined below static sexp* node_list_interp_fixup(sexp* x, sexp* parent, sexp* env, struct ast_rotation_info* rotation_info, bool expand_lhs); /** * maybe_rotate() - Rotate if we found a pivot * * @op: Problematic operator. * @env: The unquoting environment. * @info: See &struct ast_rotation_info. * * If @op has precedence over the upper pivot, this is the upper * root. Otherwise use &ast_rotation_info->upper_root. If the latter * is not defined, this means no rotation is needed because the effect * of `!` on the AST corresponds to the implicit grouping (e.g. with * `1 + !!2 * 3`). */ static sexp* maybe_rotate(sexp* op, sexp* env, struct ast_rotation_info* info) { if (info->upper_pivot_op == R_OP_NONE) { return op; } // Rotate if `op` is the upper root if (r_lhs_op_has_precedence(r_which_operator(op), info->upper_pivot_op)) { // Swap the lower root's RHS with the lower pivot's LHS r_node_poke_car(info->lower_root, r_node_cadr(info->lower_pivot)); r_node_poke_cadr(info->lower_pivot, op); // After rotation the upper pivot is the new root op = info->upper_pivot; } else if (info->upper_root) { r_node_poke_car(info->lower_root, r_node_cadr(info->lower_pivot)); r_node_poke_cadr(info->lower_pivot, info->upper_root); r_node_poke_car(r_node_cddr(info->root_parent), info->upper_pivot); } // else there is no rotation needed // Reinitialise the `ast_rotation_info` on the stack in order to // reuse it in the recursion initialise_rotation_info(info); // Recurse on the RHS of the upper pivot (which is now the new root) node_list_interp_fixup(op, NULL, env, info, false); return maybe_rotate(op, env, info); } /** * fixup_interp() - Expand a problematic operation * * @x: A problematic operation, i.e. a call to an operator whose * precedence is between that of `!` and that of `!!`. * @env: The unquoting environment. * * The expression to expand is an operator that might need changes in * the AST if we find a `!!` call down the line. From this point on * there is a &struct ast_rotation_info on the stack. */ sexp* fixup_interp(sexp* x, sexp* env) { struct ast_rotation_info rotation_info; initialise_rotation_info(&rotation_info); // Look for problematic !! calls and expand arguments on the way. // If a pivot is found rotate it around `x`. node_list_interp_fixup(x, NULL, env, &rotation_info, true); return maybe_rotate(x, env, &rotation_info); } /** * fixup_interp_first() - Expand a problematic operation starting with `!!` * * @x: A problematic operation whose LHS is a `!!` call, e.g. `!!1 + 2 + 3`. * @env: The unquoting environment. * * If `!!` is the root expression there is no rotation needed. Just * unquote the leftmost child across problematic binary operators. * However the resulting root might be involved in a rotation for a * subsequent `!!` call. */ sexp* fixup_interp_first(sexp* x, sexp* env) { sexp* parent = NULL; // `parent` will always be initialised in the loop sexp* target = x; while (is_problematic_op((parent = target, target = r_node_cadr(target))) && !is_unary(target)); // Unquote target r_node_poke_cadr(parent, r_eval(target, env)); // Expand the new root but no need to expand LHS as we just unquoted it struct ast_rotation_info rotation_info; initialise_rotation_info(&rotation_info); node_list_interp_fixup(x, NULL, env, &rotation_info, true); return maybe_rotate(x, env, &rotation_info); } /** * find_upper_pivot() - Find upper pivot * * @x: An expression. * @info: See &struct ast_rotation_info. * * Detect `!!` call structures. The operand is the upper pivot. Fill * in &ast_rotation_info->upper_pivot_op and * &ast_rotation_info->upper_pivot within @info. */ static void find_upper_pivot(sexp* x, struct ast_rotation_info* info) { if (!r_is_call(x, "!")) { return; } x = r_node_cadr(x); if (!r_is_call(x, "!")) { return; } x = r_node_cadr(x); if (r_is_call(x, "!")) { return; } enum r_operator op = r_which_operator(x); if (!op_needs_fixup(op)) { return; } info->upper_pivot_op = op; info->upper_pivot = x; } /** * find_lower_pivot() - Find lower pivot and unquote target * * @x: This is the upper pivot in the first call and the LHS of the * previous node when recursing. * @parent_node: Used to handle unary `+` and `-`, e.g. `1 + !!-2 + 3`. * @env: Unquoting environment. * @info: See &struct ast_rotation_info. * * Climb through LHS's until we find an operator that has greater * precendence than the upper pivot. This node is the lower pivot * whose LHS will be attached to the upper root. Continue climbing the * LHS's until we find the target and unquote it in place. Expand all * RHS's on the way there. * * Fill in &ast_rotation_info->lower_pivot within @info. */ static void find_lower_pivot(sexp* x, sexp* parent_node, sexp* env, struct ast_rotation_info* info) { sexp* lhs_node = r_node_cdr(x); sexp* rhs_node = r_node_cdr(lhs_node); // We found an unary `+` or `-` on the way if (rhs_node == r_null) { sexp* target = r_eval(x, env); if (parent_node) { r_node_poke_car(parent_node, target); } else { r_node_poke_car(info->lower_root, target); // If there is no parent x there is no operator precedence to // fix so abort recursion initialise_rotation_info(info); } return; } // Only expand RHS if not the upper pivot because there might be // consecutive rotations needed. The upper pivot's RHS will be // expanded after the current rotation is complete. if (x != info->upper_pivot) { r_node_poke_car(rhs_node, call_interp(r_node_car(rhs_node), env)); } sexp* lhs = r_node_car(lhs_node); enum r_operator lhs_op = r_which_operator(lhs); if (!op_needs_fixup(lhs_op)) { if (!info->lower_pivot) { info->lower_pivot = x; } sexp* target = r_eval(lhs, env); r_node_poke_cadr(x, target); // Stop recursion as we found both target and lower pivot return; } if (!r_lhs_op_has_precedence(info->upper_pivot_op, lhs_op)) { info->lower_pivot = x; } // Recurse find_lower_pivot(lhs, lhs_node, env, info); } // Defined below static void node_list_interp_fixup_rhs(sexp* rhs, sexp* rhs_node, sexp* parent, sexp* env, struct ast_rotation_info* info); /** * node_list_interp_fixup() - Expansion for binary operators that might need fixup * * @x A call to a binary operator whith problematic precedence * (between prec(`!`) and prec(`!!`)). * @env The environment where to unquote the `!!` target. * @parent Needed to handle a mix of unary and binary operators * supplied to the unquote operator, e.g. `!!-1 + 2`. This is the * outer call of which `x` is an argument, or the C `NULL` if there * is none. * @info Information about the pivot, the root and the unquoted target. * @expand_lhs Whether to expand the LHS. In some cases (e.g. after a * rotation) it is not necessary to expand the LHS as it was already * visited. */ static sexp* node_list_interp_fixup(sexp* x, sexp* parent, sexp* env, struct ast_rotation_info* info, bool expand_lhs) { sexp* lhs_node = r_node_cdr(x); sexp* lhs = r_node_car(lhs_node); // If there's a unary `+` or `-` on the way recurse on its RHS if (is_unary_plusminus(x)) { node_list_interp_fixup_rhs(lhs, lhs_node, parent, env, info); return x; } sexp* rhs_node = r_node_cddr(x); sexp* rhs = r_node_car(rhs_node); if (expand_lhs) { // Expand the LHS normally, it never needs changes in the AST struct expansion_info expansion_info = is_big_bang_op(lhs); if (expansion_info.op == OP_EXPAND_UQS) { sexp* node = big_bang(expansion_info.operand, env, lhs_node, rhs_node); rhs_node = r_node_cdr(node); } else { r_node_poke_car(lhs_node, call_interp(r_node_car(lhs_node), env)); } } node_list_interp_fixup_rhs(rhs, rhs_node, x, env, info); return x; } /** * node_list_interp_fixup_rhs() - Expansion for binary operators that might need fixup * * @rhs: The right-hand side argument of an operator with problematic * precedence. * @rhs_node: Parent node of RHS. If `rhs` is a `!!` call, we reattach * the `!!` operand to its parent node `rhs_node`. * @parent: See node_list_interp_fixup(). * @env: The unquoting environment. * @info: See &struct ast_rotation_info. */ static void node_list_interp_fixup_rhs(sexp* rhs, sexp* rhs_node, sexp* parent, sexp* env, struct ast_rotation_info* info) { // An upper pivot is an operand of a !! call that is a binary // operation whose precedence is problematic (between prec(`!`) and // prec(`!!`)) find_upper_pivot(rhs, info); if (info->upper_pivot) { info->lower_root = rhs_node; // There might be a lower pivot, so we need to find it. Also find // the target of unquoting (leftmost leaf whose predecence is // greater than prec(`!!`)) and unquote it. find_lower_pivot(info->upper_pivot, NULL, env, info); if (info->upper_pivot) { // Reattach the RHS to the upper pivot stripped of its !! call // in case there is no rotation around the lower root r_node_poke_car(rhs_node, info->upper_pivot); } return; } // If `rhs` is an operator that might be involved in a rotation // recurse with the fixup version if (is_problematic_op(rhs)) { node_list_interp_fixup(rhs, parent, env, info, true); // This might the upper root around which to rotate if (info->upper_pivot_op && r_lhs_op_has_precedence(r_which_operator(rhs), info->upper_pivot_op)) { info->upper_root = rhs; info->root_parent = parent; } return; } // RHS is not a binary operation that might need changes in the AST // so expand it as usual r_node_poke_car(rhs_node, call_interp(rhs, env)); } rlang/src/internal/arg.c0000644000176200001440000000277113242736425014714 0ustar liggesusers#include #include "expr-interp.h" // Capture sexp* rlang_ns_get(const char* name); sexp* capture(sexp* sym, sexp* frame, SEXP* arg_env) { static sexp* capture_call = NULL; if (!capture_call) { sexp* args = KEEP(r_new_node(r_null, r_null)); capture_call = r_new_call_node(rlang_ns_get("captureArgInfo"), args); r_mark_precious(capture_call); r_mark_shared(capture_call); FREE(1); } if (r_typeof(sym) != SYMSXP) { r_abort("`arg` must be a symbol"); } r_node_poke_cadr(capture_call, sym); sexp* arg_info = KEEP(r_eval(capture_call, frame)); sexp* expr = r_list_get(arg_info, 0); sexp* env = r_list_get(arg_info, 1); // Unquoting rearranges the expression expr = KEEP(r_duplicate(expr, false)); expr = call_interp(expr, env); if (arg_env) { *arg_env = env; } FREE(2); return expr; } sexp* rlang_enexpr(sexp* sym, sexp* frame) { return capture(sym, frame, NULL); } sexp* rlang_ensym(sexp* sym, sexp* frame) { sexp* expr = capture(sym, frame, NULL); switch (r_typeof(expr)) { case r_type_symbol: break; case r_type_character: if (r_length(expr) == 1) { KEEP(expr); expr = r_sym(r_c_string(expr)); FREE(1); break; } // else fallthrough default: r_abort("Must supply a symbol or a string as argument"); } return expr; } sexp* rlang_enquo(sexp* sym, sexp* frame) { sexp* env; sexp* expr = KEEP(capture(sym, frame, &env)); sexp* quo = forward_quosure(expr, env); FREE(1); return quo; } rlang/src/internal/utils.h0000644000176200001440000000030013242736425015272 0ustar liggesusers#ifndef RLANG_INTERNAL_UTILS_H #define RLANG_INTERNAL_UTILS_H sexp* new_preserved_empty_list(); void signal_soft_deprecation(const char* msg); sexp* rlang_ns_get(const char* name); #endif rlang/src/internal/eval-tidy.c0000644000176200001440000002426213242736425016040 0ustar liggesusers#include #include "internal.h" static sexp* tilde_thunk_fmls = NULL; static sexp* tilde_thunk_body = NULL; sexp* new_tilde_thunk(sexp* data_mask, sexp* data_mask_top) { sexp* body = KEEP(r_duplicate(tilde_thunk_body, false)); sexp* fn = KEEP(r_new_function(tilde_thunk_fmls, body, r_base_env)); sexp* args = r_node_cdr(r_node_cddr(body)); r_node_poke_car(args, data_mask); r_node_poke_cadr(args, data_mask_top); FREE(2); return fn; } static sexp* data_pronoun_names = NULL; static sexp* data_pronoun_class = NULL; // Exported for deprecated as_dictionary() generic sexp* rlang_new_data_pronoun(sexp* x, sexp* lookup_msg, sexp* read_only) { sexp* dict = KEEP(r_new_vector(r_type_list, 3)); r_list_poke(dict, 0, x); r_list_poke(dict, 2, read_only); if (lookup_msg == r_null) { r_list_poke(dict, 1, r_scalar_chr("Object `%s` not found in `.data`")); } else { r_list_poke(dict, 1, lookup_msg); } r_poke_attribute(dict, r_names_sym, data_pronoun_names); r_poke_attribute(dict, r_class_sym, data_pronoun_class); FREE(1); return dict; } static sexp* empty_names_chr; static void check_unique_names(sexp* x) { // Allow empty lists if (!r_length(x)) { return ; } sexp* names = r_vec_names(x); if (names == r_null) { r_abort("`data` must be uniquely named but does not have names"); } if (r_vec_find_first_duplicate(names, empty_names_chr, NULL)) { r_abort("`data` must be uniquely named but has duplicate elements"); } } sexp* rlang_as_data_pronoun(sexp* x) { int n_kept = 0; switch (r_typeof(x)) { case r_type_logical: case r_type_integer: case r_type_double: case r_type_complex: case r_type_character: case r_type_raw: check_unique_names(x); x = KEEP_N(r_vec_coerce(x, r_type_list), n_kept); break; case r_type_list: check_unique_names(x); break; case r_type_environment: break; default: r_abort("`data` must be an uniquely named vector, list, data frame or environment"); } sexp* lookup_msg = KEEP_N(r_scalar_chr("Column `%s` not found in `.data`"), n_kept); sexp* read_only = KEEP_N(r_scalar_lgl(1), n_kept); sexp* pronoun = rlang_new_data_pronoun(x, lookup_msg, read_only); FREE(n_kept); return pronoun; } static sexp* data_mask_flag_sym = NULL; static sexp* data_mask_env_sym = NULL; static sexp* data_mask_top_env_sym = NULL; static void check_data_mask_input(sexp* env, const char* arg) { if (r_typeof(env) != r_type_environment) { r_abort("Can't create data mask because `%s` must be an environment", arg); } } sexp* rlang_new_data_mask(sexp* bottom, sexp* top, sexp* parent) { check_data_mask_input(parent, "parent"); sexp* data_mask; if (bottom == r_null) { data_mask = bottom = KEEP(r_new_environment(parent, 0)); } else { check_data_mask_input(bottom, "bottom"); // Create a child because we don't know what might be in `bottom` // and we need to clear its contents without deleting any object // created in the data mask environment data_mask = KEEP(r_new_environment(bottom, 0)); } if (top == r_null) { top = bottom; } else { check_data_mask_input(top, "top"); } r_env_poke(data_mask, r_tilde_sym, new_tilde_thunk(data_mask, top)); r_env_poke(data_mask, data_mask_flag_sym, data_mask); r_env_poke(data_mask, data_mask_env_sym, parent); r_env_poke(data_mask, data_mask_top_env_sym, top); FREE(1); return data_mask; } static sexp* data_pronoun_sym = NULL; sexp* rlang_as_data_mask(sexp* data, sexp* parent) { if (data == r_null) { return rlang_new_data_mask(r_null, r_null, parent); } sexp* data_pronoun = rlang_as_data_pronoun(data); sexp* bottom = NULL; int n_protect = 0; switch (r_typeof(data)) { case r_type_environment: bottom = KEEP_N(r_env_clone(data, parent), n_protect); break; case r_type_logical: case r_type_integer: case r_type_double: case r_type_complex: case r_type_character: case r_type_raw: data = r_vec_coerce(data, r_type_list); KEEP_N(data, n_protect); // fallthrough: case r_type_list: { sexp* names = r_vec_names(data); bottom = KEEP_N(r_new_environment(parent, 0), n_protect); if (names != r_null) { r_ssize_t n = r_length(data); for (r_ssize_t i = 0; i < n; ++i) { // Ignore empty or missing names sexp* nm = r_chr_get(names, i); if (r_str_is_name(nm)) { sexp* elt = r_list_get(data, i); r_env_poke(bottom, r_str_as_symbol(nm), elt); } } } break; } default: r_abort("`data` must be a vector, list, data frame, or environment"); } r_env_poke(bottom, data_pronoun_sym, data_pronoun); sexp* data_mask = rlang_new_data_mask(bottom, bottom, parent); FREE(n_protect); return data_mask; } static sexp* tilde_prim = NULL; static sexp* base_tilde_eval(sexp* tilde, sexp* quo_env) { if (r_f_has_env(tilde)) { return tilde; } // Inline the base primitive because overscopes override `~` to make // quosures self-evaluate tilde = KEEP(r_new_call_node(tilde_prim, r_node_cdr(tilde))); tilde = KEEP(r_eval(tilde, quo_env)); // Change it back because the result still has the primitive inlined r_node_poke_car(tilde, r_tilde_sym); FREE(2); return tilde; } static sexp* env_poke_parent_fn = NULL; static sexp* env_poke_fn = NULL; sexp* rlang_tilde_eval(sexp* tilde, sexp* overscope, sexp* overscope_top, sexp* cur_frame) { if (!rlang_is_quosure(tilde)) { return base_tilde_eval(tilde, overscope); } if (quo_is_missing(tilde)) { return(r_missing_arg()); } sexp* expr = rlang_quo_get_expr(tilde); if (!r_is_symbolic(expr)) { return expr; } sexp* quo_env = rlang_quo_get_env(tilde); if (r_typeof(quo_env) != r_type_environment) { r_abort("Internal error: Quosure environment is corrupt"); } int n_protect = 0; sexp* prev_env; sexp* flag = r_env_find(overscope, data_mask_flag_sym); if (flag == r_unbound_sym) { prev_env = r_env_parent(overscope); } else { prev_env = r_env_get(overscope, data_mask_env_sym); KEEP_N(prev_env, n_protect); // Help rchk // Update .env pronoun to current quosure env temporarily r_env_poke(overscope, data_mask_env_sym, quo_env); sexp* exit_args = r_build_pairlist3(overscope, r_scalar_chr(".env"), prev_env); sexp* exit_lang = KEEP(r_build_call_node(env_poke_fn, exit_args)); r_on_exit(exit_lang, cur_frame); FREE(1); } // Swap enclosures temporarily by rechaining the top of the dynamic // scope to the enclosure of the new formula, if it has one r_env_poke_parent(overscope_top, quo_env); sexp* exit_args = r_build_pairlist2(overscope_top, prev_env); sexp* exit_lang = r_build_call_node(env_poke_parent_fn, exit_args); KEEP_N(exit_lang, n_protect); r_on_exit(exit_lang, cur_frame); sexp* out = r_eval(expr, overscope); FREE(n_protect); return out; } #define DATA_MASK_OBJECTS_N 4 static const char* data_mask_objects_names[DATA_MASK_OBJECTS_N] = { ".__tidyeval_data_mask__.", "~", ".top_env", ".env" }; // Soft-deprecated in rlang 0.2.0 sexp* rlang_data_mask_clean(sexp* mask) { sexp* bottom = r_env_parent(mask); sexp* top = r_env_get(mask, data_mask_top_env_sym); KEEP(top); // Help rchk if (top == r_null) { top = bottom; } // At this level we only want to remove our own stuff r_env_unbind_all(mask, data_mask_objects_names, DATA_MASK_OBJECTS_N, false); // Remove everything in the other levels sexp* env = bottom; sexp* parent = r_env_parent(top); while (env != parent) { r_env_unbind_names(env, r_env_names(env), false); env = r_env_parent(env); } FREE(1); return mask; } static sexp* new_quosure_mask(sexp* env) { sexp* mask = KEEP(r_new_environment(env, 3)); r_env_poke(mask, r_tilde_sym, new_tilde_thunk(mask, mask)); FREE(1); return mask; } bool is_data_mask(sexp* env) { if (r_typeof(env) != r_type_environment) { return false; } else { return r_env_find(env, data_mask_flag_sym) != r_unbound_sym; } } static sexp* data_mask_clean_fn = NULL; static sexp* env_sym = NULL; sexp* rlang_eval_tidy(sexp* expr, sexp* data, sexp* frame) { int n_protect = 0; sexp* env; if (rlang_is_quosure(expr)) { env = r_quo_get_env(expr); expr = r_quo_get_expr(expr); } else { env = KEEP_N(r_eval(env_sym, frame), n_protect); } // If `data` is already a data mask, update env pronouns and // evaluate in that environment. The caller is responsible for // cleaning the mask if needed. if (is_data_mask(data)) { r_env_poke(data, data_mask_env_sym, env); sexp* top = r_env_get(data, data_mask_top_env_sym); r_env_poke_parent(top, env); sexp* out = r_eval(expr, data); FREE(n_protect); return out; } sexp* mask; // If there is no data, we only need to mask `~` with the definition // for quosure thunks. Otherwise we create a heavier data mask with // all the masking objects, data pronouns, etc. if (data == r_null) { mask = new_quosure_mask(env); } else { mask = rlang_as_data_mask(data, env); sexp* exit_args = KEEP(r_new_node(mask, r_null)); sexp* exit_call = KEEP(r_new_call_node(data_mask_clean_fn, exit_args)); r_on_exit(exit_call, frame); FREE(2); } sexp* out = r_eval(expr, mask); FREE(n_protect); return out; } const char* data_pronoun_c_names[3] = { "src", "lookup_msg", "read_only" }; void rlang_init_eval_tidy() { tilde_thunk_fmls = rlang_constants_get("tilde_thunk_fmls"); tilde_thunk_body = rlang_constants_get("tilde_thunk_body"); data_pronoun_names = r_new_character(data_pronoun_c_names, 3); r_mark_precious(data_pronoun_names); data_pronoun_class = r_scalar_chr("rlang_data_pronoun"); r_mark_precious(data_pronoun_class); empty_names_chr = r_new_vector(r_type_character, 2); r_mark_precious(empty_names_chr); r_chr_poke(empty_names_chr, 0, r_string("")); r_chr_poke(empty_names_chr, 1, r_missing_str); data_mask_flag_sym = r_sym(".__tidyeval_data_mask__."); data_mask_env_sym = r_sym(".env"); data_mask_top_env_sym = r_sym(".top_env"); data_pronoun_sym = r_sym(".data"); tilde_prim = r_base_ns_get("~"); env_poke_parent_fn = rlang_ns_get("env_poke_parent"); env_poke_fn = rlang_ns_get("env_poke"); data_mask_clean_fn = rlang_ns_get("overscope_clean"); env_sym = r_sym("env"); } rlang/src/internal/expr-interp-rotate.h0000644000176200001440000000132213242736425017710 0ustar liggesusers#ifndef RLANG_INTERNAL_EXPR_INTERP_FIXUP_H #define RLANG_INTERNAL_EXPR_INTERP_FIXUP_H static inline bool op_needs_fixup(enum r_operator op) { switch (op) { case R_OP_GREATER: case R_OP_GREATER_EQUAL: case R_OP_LESS: case R_OP_LESS_EQUAL: case R_OP_EQUAL: case R_OP_NOT_EQUAL: case R_OP_PLUS: case R_OP_MINUS: case R_OP_TIMES: case R_OP_RATIO: case R_OP_MODULO: case R_OP_SPECIAL: case R_OP_COLON1: case R_OP_PLUS_UNARY: case R_OP_MINUS_UNARY: return true; default: return false; } } static inline bool is_problematic_op(sexp* x) { return op_needs_fixup(r_which_operator(x)); } sexp* fixup_interp(sexp* x, sexp* env); sexp* fixup_interp_first(sexp* x, sexp* env); #endif rlang/src/internal/quo.c0000644000176200001440000000364113242736425014744 0ustar liggesusers#include #define QUO_TAGS_N 2 static const char* quo_tags[QUO_TAGS_N] = { "quosure", "formula" }; sexp* new_raw_formula(sexp* lhs, sexp* rhs, sexp* env); sexp* rlang_new_quosure(sexp* expr, sexp* env) { sexp* quo = KEEP(new_raw_formula(r_null, expr, env)); r_push_classes(quo, quo_tags, QUO_TAGS_N); FREE(1); return quo; } bool rlang_is_quosure(sexp* x) { return r_typeof(x) == r_type_call && Rf_inherits(x, "quosure"); } inline void check_quosure(sexp* quo) { if (!rlang_is_quosure(quo)) { r_abort("`quo` must be a quosure"); } } sexp* rlang_quo_get_expr(sexp* quo) { check_quosure(quo); return r_node_cadr(quo); } sexp* rlang_quo_set_expr(sexp* quo, sexp* expr) { check_quosure(quo); quo = r_duplicate(quo, true); return r_node_poke_cadr(quo, expr); } sexp* rlang_quo_get_env(sexp* quo) { check_quosure(quo); return r_get_attribute(quo, r_dot_environment_sym); } sexp* rlang_quo_set_env(sexp* quo, sexp* env) { check_quosure(quo); if (r_typeof(env) != r_type_environment) { r_abort("`env` must be an environment"); } return r_set_attribute(quo, r_dot_environment_sym, env); } sexp* rlang_get_expression(sexp* x, sexp* alternate) { switch (r_typeof(x)) { case LANGSXP: if (r_is_formulaish(x, -1, 0)) { return r_f_rhs(x); } break; // case CLOSXP: // return r_fn_body(x); case VECSXP: if (r_inherits(x, "frame")) { return r_list_get(x, 2); } break; default: break; } if (alternate) { return alternate; } else { return x; } } bool quo_is_missing(sexp* quo) { return r_node_cadr(quo) == R_MissingArg; } bool quo_is_symbol(sexp* quo) { return r_typeof(r_node_cadr(quo)) == r_type_symbol; } bool quo_is_call(sexp* quo) { return r_typeof(r_node_cadr(quo)) == r_type_call; } bool quo_is_symbolic(sexp* quo) { return r_is_symbolic(r_node_cadr(quo)); } bool quo_is_null(sexp* quo) { return r_node_cadr(quo) == r_null; } rlang/src/internal/internal.h0000644000176200001440000000035313242736425015756 0ustar liggesusers#ifndef RLANG_INTERNAL_INTERNAL_H #define RLANG_INTERNAL_INTERNAL_H #include "quo.h" sexp* rlang_constants_env; void rlang_init_internal(); sexp* rlang_ns_get(const char* name); sexp* rlang_constants_get(const char* name); #endif rlang/src/internal/expr-interp.c0000644000176200001440000002072113242736425016413 0ustar liggesusers#include #include "expr-interp.h" #include "expr-interp-rotate.h" #include "utils.h" struct expansion_info which_bang_op(sexp* first) { struct expansion_info info = init_expansion_info(); if (r_is_call(first, "(")) { sexp* paren = r_node_cadr(first); if (r_is_call(paren, "(")) { return info; } struct expansion_info inner_info = which_bang_op(paren); // Check that `root` is NULL so we don't remove parentheses when // there's an operation tail (i.e. when the parse tree was fixed // up to bind tightly) if (inner_info.op == OP_EXPAND_UQ && inner_info.root == r_null) { return inner_info; } else { return info; } } if (!r_is_call(first, "!")) { return info; } sexp* second = r_node_cadr(first); if (!r_is_call(second, "!")) { return info; } sexp* third = r_node_cadr(second); // Need to fill in `info` for `!!` because parse tree might need changes if (!r_is_call(third, "!")) { if (is_problematic_op(third)) { info.op = OP_EXPAND_FIXUP; info.operand = third; } else { info.op = OP_EXPAND_UQ; info.parent = r_node_cdr(second); info.operand = third; } return info; } info.op = OP_EXPAND_UQS; info.operand = r_node_cadr(third); return info; } // These functions are questioning and might be soft-deprecated in the // future void signal_uq_soft_deprecation() { return ; signal_soft_deprecation( "`UQ()` is soft-deprecated as of rlang 0.2.0. " "Please use the prefix form of `!!` instead." ); } void signal_uqs_soft_deprecation() { return ; signal_soft_deprecation( "`UQS()` is soft-deprecated as of rlang 0.2.0. " "Please use the prefix form of `!!!` instead." ); } void signal_namespaced_uq_deprecation() { signal_soft_deprecation( "Prefixing `UQ()` with a namespace is soft-deprecated as of rlang 0.2.0. " "Please use the unprefixed form instead." ); } void signal_namespaced_uqs_deprecation() { signal_soft_deprecation( "Prefixing `UQS()` with a namespace is soft-deprecated as of rlang 0.2.0. " "Please use the unprefixed form instead." ); } void maybe_poke_big_bang_op(sexp* x, struct expansion_info* info) { if (r_is_call(x, "!!!")) { if (r_node_cddr(x) != r_null) { r_abort("Can't supply multiple arguments to `!!!`"); } info->op = OP_EXPAND_UQS; info->operand = r_node_cadr(x); return ; } // Handle expressions like foo::`!!`(bar) or foo$`!!`(bar) if (r_is_prefixed_call(x, "!!!")) { const char* name = r_sym_c_str(r_node_caar(x)); r_abort("Prefix form of `!!!` can't be used with `%s`", name); } bool namespaced_uqs = r_is_namespaced_call(x, "rlang", "UQS"); if (namespaced_uqs) { signal_namespaced_uqs_deprecation(); } if (namespaced_uqs || r_is_call(x, "UQS")) { signal_uqs_soft_deprecation(); info->op = OP_EXPAND_UQS; info->operand = r_node_cadr(x); return ; } } struct expansion_info which_expansion_op(sexp* x, bool unquote_names) { struct expansion_info info = which_bang_op(x); if (r_typeof(x) != r_type_call) { return info; } if (info.op) { return info; } if (is_problematic_op(x)) { info.op = OP_EXPAND_FIXUP; return info; } if (unquote_names && r_is_call(x, ":=")) { info.op = OP_EXPAND_UQN; return info; } if (r_is_call(x, "!!")) { info.op = OP_EXPAND_UQ; info.operand = r_node_cadr(x); return info; } // Handle expressions like foo::`!!`(bar) or foo$`!!`(bar) if (r_is_prefixed_call(x, "!!")) { info.op = OP_EXPAND_UQ; info.operand = r_node_cadr(x); info.parent = r_node_cdr(r_node_cdar(x)); info.root = r_node_car(x); return info; } maybe_poke_big_bang_op(x, &info); if (info.op == OP_EXPAND_UQS) { return info; } // This logic is complicated because rlang::UQ() gets fully unquoted // but not foobar::UQ(). The functional form UI is now retired so // we'll be able to simplify this in the future. if (r_is_prefixed_call(x, "UQ")) { signal_uq_soft_deprecation(); info.op = OP_EXPAND_UQ; info.operand = r_node_cadr(x); if (r_is_namespaced_call(x, "rlang", NULL)) { signal_namespaced_uq_deprecation(); } else { info.parent = r_node_cdr(r_node_cdar(x)); info.root = r_node_car(x); } return info; } if (r_is_call(x, "UQ")) { signal_uq_soft_deprecation(); info.op = OP_EXPAND_UQ; info.operand = r_node_cadr(x); return info; } if (r_is_prefixed_call_any(x, uqe_names, UQE_N)) { info.op = OP_EXPAND_UQE; info.operand = r_node_cadr(x); if (!r_is_namespaced_call(x, "rlang", NULL)) { info.parent = r_node_cdr(r_node_cdar(x)); info.root = r_node_car(x); } return info; } if (r_is_call_any(x, uqe_names, UQE_N)) { info.op = OP_EXPAND_UQE; info.operand = r_node_cadr(x); return info; } return info; } struct expansion_info is_big_bang_op(sexp* x) { struct expansion_info info = which_bang_op(x); if (info.op != OP_EXPAND_UQS) { maybe_poke_big_bang_op(x, &info); } return info; } static sexp* bang_bang_teardown(sexp* value, struct expansion_info info) { if (info.parent != r_null) { r_node_poke_car(info.parent, value); } if (info.root == r_null) { return value; } else { return info.root; } } static sexp* bang_bang(struct expansion_info info, sexp* env) { sexp* value = r_eval(info.operand, env); return bang_bang_teardown(value, info); } static sexp* bang_bang_expression(struct expansion_info info, sexp* env) { sexp* value = KEEP(r_eval(info.operand, env)); if (r_is_formulaish(value, -1, 0)) { value = rlang_get_expression(value, NULL); } value = bang_bang_teardown(value, info); FREE(1); return value; } sexp* big_bang_coerce(sexp* expr) { switch (r_typeof(expr)) { case r_type_null: return expr; case r_type_pairlist: return r_duplicate(expr, true); case r_type_logical: case r_type_integer: case r_type_double: case r_type_complex: case r_type_character: case r_type_raw: case r_type_list: return r_vec_coerce(expr, r_type_pairlist); case r_type_call: if (r_is_symbol(r_node_car(expr), "{")) { return r_node_cdr(expr); } // else fallthrough default: return r_new_node(expr, r_null); } } sexp* big_bang(sexp* operand, sexp* env, sexp* node, sexp* next) { sexp* value = KEEP(r_eval(operand, env)); value = big_bang_coerce(value); if (value == r_null) { r_node_poke_cdr(node, r_node_cdr(next)); } else { // Insert coerced value into existing pairlist of args r_node_poke_cdr(r_node_tail(value), r_node_cdr(next)); r_node_poke_cdr(node, value); } FREE(1); return next; } // Defined below static sexp* node_list_interp(sexp* x, sexp* env); sexp* call_interp(sexp* x, sexp* env) { struct expansion_info info = which_expansion_op(x, false); return call_interp_impl(x, env, info); } sexp* call_interp_impl(sexp* x, sexp* env, struct expansion_info info) { if (info.op && r_node_cdr(x) == r_null) { r_abort("`UQ()`, `UQE()` and `UQS()` must be called with an argument"); } if (info.op == OP_EXPAND_UQE) { r_warn("`UQE()` is deprecated. Please use `!! get_expr(x)`"); } switch (info.op) { case OP_EXPAND_NONE: if (r_typeof(x) != r_type_call) { return x; } else { return node_list_interp(x, env); } case OP_EXPAND_UQ: return bang_bang(info, env); case OP_EXPAND_UQE: return bang_bang_expression(info, env); case OP_EXPAND_FIXUP: if (info.operand == r_null) { return fixup_interp(x, env); } else { return fixup_interp_first(info.operand, env); } case OP_EXPAND_UQS: r_abort("Can't use `!!!` at top level"); case OP_EXPAND_UQN: r_abort("Internal error: Deep `:=` unquoting"); } // Silence mistaken noreturn warning on GCC r_abort("Never reached"); } static sexp* node_list_interp(sexp* x, sexp* env) { for (sexp* node = x; node != r_null; node = r_node_cdr(node)) { r_node_poke_car(node, call_interp(r_node_car(node), env)); sexp* next = r_node_cdr(node); sexp* next_head = r_node_car(next); struct expansion_info info = is_big_bang_op(next_head); if (info.op == OP_EXPAND_UQS) { node = big_bang(info.operand, env, node, next); } } return x; } sexp* rlang_interp(sexp* x, sexp* env) { if (!r_is_environment(env)) { r_abort("`env` must be an environment"); } if (r_typeof(x) != r_type_call) { return x; } x = KEEP(r_duplicate(x, false)); x = call_interp(x, env); FREE(1); return x; } rlang/src/internal/internal.c0000644000176200001440000000071013242736425015746 0ustar liggesusers#include #include "internal.h" sexp* rlang_constants_env; sexp* rlang_constants_get(const char* name) { return r_env_get(rlang_constants_env, r_sym(name)); } void rlang_init_eval_tidy(); void rlang_init_internal() { // Should be first rlang_constants_env = rlang_ns_get("c_constants_env"); rlang_init_eval_tidy(); /* dots.c - enum dots_expansion_op */ RLANG_ASSERT(OP_DOTS_MAX == DOTS_CAPTURE_TYPE_MAX * EXPANSION_OP_MAX); } rlang/src/internal/quo.h0000644000176200001440000000071613242736425014751 0ustar liggesusers#ifndef RLANG_INTERNAL_QUO_H #define RLANG_INTERNAL_QUO_H sexp* rlang_new_quosure(sexp* expr, sexp* env); bool rlang_is_quosure(sexp* x); sexp* rlang_get_expression(sexp* x, sexp* alternate); sexp* rlang_quo_get_env(sexp* quo); sexp* rlang_quo_get_expr(sexp* quo); void check_quosure(sexp* x); bool quo_is_missing(sexp* quo); bool quo_is_symbol(sexp* quo); bool quo_is_call(sexp* quo); bool quo_is_symbolic(sexp* quo); bool quo_is_null(sexp* quo); #endif rlang/src/lib.c0000644000176200001440000000125213242736425013066 0ustar liggesusers// This is an include point for the implementations of the rlang // library. It should be included in a single and separate compilation // unit. #include "lib/rlang.h" #include "lib/attrs.c" #include "lib/cnd.c" #include "lib/env.c" #include "lib/eval.c" #include "lib/export.c" #include "lib/fn.c" #include "lib/formula.c" #include "lib/lang.c" #include "lib/node.c" #include "lib/parse.c" #include "lib/quo.c" #include "lib/replace-na.c" #include "lib/rlang.c" #include "lib/sexp.c" #include "lib/squash.c" #include "lib/stack.c" #include "lib/sym.c" #include "lib/sym-unescape.c" #include "lib/vec.c" #include "lib/vec-chr.c" #include "lib/vec-lgl.c" #include "lib/vec-list.c" rlang/src/export/0000755000176200001440000000000013242771563013477 5ustar liggesusersrlang/src/export/exported-tests.c0000644000176200001440000000121013242736425016625 0ustar liggesusers#include sexp* rlang_test_r_warn(sexp* x) { r_warn(CHAR(STRING_ELT(x, 0))); return r_null; } sexp* rlang_r_string(sexp* str) { return STRING_ELT(str, 0); } // env.c sexp* rlang_test_base_ns_get(sexp* name) { return r_base_ns_get(r_c_string(name)); } // sym.c sexp* rlang_test_is_special_op_sym(sexp* x) { return Rf_ScalarLogical(r_is_special_op_sym(x)); } // squash.c bool rlang_is_clevel_spliceable(sexp* x) { return Rf_inherits(x, "foo"); } // stack.c sexp* rlang_test_sys_call(sexp* n) { return r_sys_call(r_c_int(n), NULL); } sexp* rlang_test_sys_frame(sexp* n) { return r_sys_frame(r_c_int(n), NULL); } rlang/src/export/exported.c0000644000176200001440000001262513242736425015501 0ustar liggesusers#include // attrs.c sexp* rlang_poke_attributes(sexp* x, sexp* attrs) { SET_ATTRIB(x, attrs); return x; } // cnd.c sexp* rlang_cnd_signal(sexp* cnd, sexp* mufflable) { r_cnd_signal(cnd, r_as_bool(mufflable)); return r_null; } sexp* rlang_cnd_inform(sexp* cnd, sexp* mufflable) { r_cnd_inform(cnd, r_as_bool(mufflable)); return r_null; } sexp* rlang_cnd_warn(sexp* cnd, sexp* mufflable) { r_cnd_warn(cnd, r_as_bool(mufflable)); return r_null; } sexp* rlang_cnd_abort(sexp* cnd, sexp* mufflable) { r_cnd_abort(cnd, r_as_bool(mufflable)); return r_null; } // env.c sexp* rlang_env_poke_parent(sexp* env, sexp* new_parent) { SET_ENCLOS(env, new_parent); return env; } sexp* rlang_env_frame(sexp* env) { return FRAME(env); } sexp* rlang_env_hash_table(sexp* env) { return HASHTAB(env); } // eval.c sexp* rlang_eval(sexp* expr, sexp* env) { return Rf_eval(expr, env); } // formula.c sexp* rlang_is_formulaish(sexp* x, sexp* scoped, sexp* lhs) { int scoped_int = r_as_optional_bool(scoped); int lhs_int = r_as_optional_bool(lhs); bool out = r_is_formulaish(x, scoped_int, lhs_int); return Rf_ScalarLogical(out); } // parse.c sexp* rlang_call_has_precedence(sexp* x, sexp* y, sexp* side) { bool has_predence; if (side == r_null) { has_predence = r_call_has_precedence(x, y); } else if (r_is_string(side, "lhs")) { has_predence = r_lhs_call_has_precedence(x, y); } else if (r_is_string(side, "rhs")) { has_predence = r_rhs_call_has_precedence(x, y); } else { r_abort("`side` must be NULL, \"lhs\" or \"rhs\""); } return r_scalar_lgl(has_predence); } sexp* rlang_which_operator(sexp* call) { const char* op = r_op_as_c_string(r_which_operator(call)); return r_scalar_chr(op); } // node.c sexp* rlang_node_car(sexp* x) { return CAR(x); } sexp* rlang_node_cdr(sexp* x) { return CDR(x); } sexp* rlang_node_caar(sexp* x) { return CAAR(x); } sexp* rlang_node_cadr(sexp* x) { return CADR(x); } sexp* rlang_node_cdar(sexp* x) { return CDAR(x); } sexp* rlang_node_cddr(sexp* x) { return CDDR(x); } sexp* rlang_node_tail(sexp* x) { while (CDR(x) != r_null) x = CDR(x); return x; } sexp* rlang_node_poke_car(sexp* x, sexp* newcar) { SETCAR(x, newcar); return x; } sexp* rlang_node_poke_cdr(sexp* x, sexp* newcdr) { SETCDR(x, newcdr); return x; } sexp* rlang_node_poke_caar(sexp* x, sexp* newcaar) { SETCAR(CAR(x), newcaar); return x; } sexp* rlang_node_poke_cadr(sexp* x, sexp* newcar) { SETCADR(x, newcar); return x; } sexp* rlang_node_poke_cdar(sexp* x, sexp* newcdar) { SETCDR(CAR(x), newcdar); return x; } sexp* rlang_node_poke_cddr(sexp* x, sexp* newcdr) { SETCDR(CDR(x), newcdr); return x; } sexp* rlang_new_node_(sexp* car, sexp* cdr) { return Rf_cons(car, cdr); } sexp* rlang_node_tag(sexp* x) { return TAG(x); } sexp* rlang_node_poke_tag(sexp* x, sexp* tag) { SET_TAG(x, tag); return x; } sexp* rlang_on_exit(sexp* expr, sexp* frame) { r_on_exit(expr, frame); return r_null; } // lang.h sexp* rlang_new_call_node(sexp* car, sexp* cdr) { return Rf_lcons(car, cdr); } // quo.h #include "../internal/quo.h" sexp* rlang_quo_is_missing(sexp* quo) { check_quosure(quo); return r_scalar_lgl(quo_is_missing(quo)); } sexp* rlang_quo_is_symbol(sexp* quo) { check_quosure(quo); return r_scalar_lgl(quo_is_symbol(quo)); } sexp* rlang_quo_is_call(sexp* quo) { check_quosure(quo); return r_scalar_lgl(quo_is_call(quo)); } sexp* rlang_quo_is_symbolic(sexp* quo) { check_quosure(quo); return r_scalar_lgl(quo_is_symbolic(quo)); } sexp* rlang_quo_is_null(sexp* quo) { check_quosure(quo); return r_scalar_lgl(quo_is_null(quo)); } // sexp.h sexp* rlang_length(sexp* x) { return Rf_ScalarInteger(r_length(x)); } sexp* rlang_true_length(sexp* x) { return Rf_ScalarInteger(TRUELENGTH(x)); } sexp* rlang_is_reference(sexp* x, sexp* y) { return r_scalar_lgl(x == y); } sexp* rlang_missing_arg() { return R_MissingArg; } sexp* rlang_duplicate(sexp* x, sexp* shallow) { return r_duplicate(x, r_as_bool(shallow)); } sexp* rlang_is_null(sexp* x) { return r_scalar_lgl(r_is_null(x)); } sexp* rlang_sxp_address(sexp* x) { static char str[1000]; snprintf(str, 1000, "%p", (void*) x); return Rf_mkString(str); } sexp* rlang_poke_type(sexp* x, sexp* type) { SET_TYPEOF(x, Rf_str2type(r_c_string(type))); return x; } sexp* rlang_mark_object(sexp* x) { SET_OBJECT(x, 1); return x; } sexp* rlang_unmark_object(sexp* x) { SET_OBJECT(x, 0); return x; } // vec.h sexp* rlang_vec_coerce(sexp* x, sexp* type) { return Rf_coerceVector(x, Rf_str2type(r_c_string(type))); } // TODO: C-level check for scalar integerish int r_as_int(sexp* x) { switch(r_typeof(x)) { case r_type_integer: return *INTEGER(x); case r_type_double: return (int) *REAL(x); default: r_abort("Internal error: Expected integerish input"); } } sexp* rlang_vec_poke_n(sexp* x, sexp* offset, sexp* y, sexp* from, sexp* n) { r_ssize_t offset_size = r_as_int(offset) - 1; r_ssize_t from_size = r_as_int(from) - 1; r_ssize_t n_size = r_as_int(n); r_vec_poke_n(x, offset_size, y, from_size, n_size); return x; } sexp* rlang_vec_poke_range(sexp* x, sexp* offset, sexp* y, sexp* from, sexp* to) { r_ssize_t offset_size = r_as_int(offset) - 1; r_ssize_t from_size = r_as_int(from) - 1; r_ssize_t to_size = r_as_int(to) - 1; r_vec_poke_range(x, offset_size, y, from_size, to_size); return x; } rlang/src/export/init.c0000644000176200001440000003143713242736425014614 0ustar liggesusers#include #include #include // Callable from other packages extern sexp* rlang_new_data_pronoun(sexp*, sexp*, sexp*); extern sexp* r_squash_if(sexp*, enum r_type, bool (*is_spliceable)(sexp*), int); extern bool rlang_is_clevel_spliceable(sexp*); extern bool rlang_is_quosure(sexp*); // Callable from this package extern sexp* rlang_is_null(sexp*); extern sexp* r_f_lhs(sexp*); extern sexp* r_f_rhs(sexp*); extern sexp* r_new_condition(sexp*, sexp*, sexp*); extern sexp* r_env_clone(sexp*, sexp*); extern sexp* rlang_env_unbind(sexp*, sexp*); extern sexp* rlang_env_poke_parent(sexp*, sexp*); extern sexp* rlang_env_frame(sexp* env); extern sexp* rlang_env_hash_table(sexp* env); extern sexp* rlang_poke_type(sexp*, sexp*); extern sexp* rlang_replace_na(sexp*, sexp*); extern sexp* rlang_node_car(sexp*); extern sexp* rlang_node_cdr(sexp*); extern sexp* rlang_node_caar(sexp*); extern sexp* rlang_node_cadr(sexp*); extern sexp* rlang_node_cdar(sexp*); extern sexp* rlang_node_cddr(sexp*); extern sexp* rlang_missing_arg(); extern sexp* rlang_node_poke_car(sexp*, sexp*); extern sexp* rlang_node_poke_cdr(sexp*, sexp*); extern sexp* rlang_node_poke_caar(sexp*, sexp*); extern sexp* rlang_node_poke_cadr(sexp*, sexp*); extern sexp* rlang_node_poke_cdar(sexp*, sexp*); extern sexp* rlang_node_poke_cddr(sexp*, sexp*); extern sexp* rlang_new_node_(sexp*, sexp*); extern sexp* rlang_duplicate(sexp*, sexp*); extern sexp* r_node_tree_clone(sexp*); extern sexp* rlang_node_tag(sexp*); extern sexp* rlang_node_poke_tag(sexp*, sexp*); extern sexp* rlang_eval(sexp*, sexp*); extern sexp* rlang_zap_attrs(sexp*); extern sexp* rlang_get_attrs(sexp*); extern sexp* rlang_set_attrs(sexp*, sexp*); extern sexp* rlang_interp(sexp*, sexp*); extern sexp* rlang_is_formulaish(sexp*, sexp*, sexp*); extern sexp* rlang_is_reference(sexp*, sexp*); extern sexp* rlang_sxp_address(sexp*); extern sexp* rlang_length(sexp*); extern sexp* rlang_true_length(sexp* x); extern sexp* rlang_new_data_pronoun(sexp*, sexp*, sexp*); extern sexp* rlang_squash(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_symbol(sexp*); extern sexp* rlang_symbol_to_character(sexp*); extern sexp* rlang_tilde_eval(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_unescape_character(sexp*); extern sexp* rlang_capturearginfo(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_capturedots(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_new_call_node(sexp*, sexp*); extern sexp* rlang_cnd_abort(sexp*, sexp*); extern sexp* rlang_cnd_inform(sexp*, sexp*); extern sexp* rlang_cnd_signal(sexp*, sexp*); extern sexp* rlang_cnd_warn(sexp*, sexp*); extern sexp* rlang_r_string(sexp*); extern sexp* rlang_exprs_interp(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_quos_interp(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_dots_values(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_dots_list(sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_dots_flat_list(sexp*, sexp*, sexp*, sexp*); extern sexp* r_new_formula(sexp*, sexp*, sexp*); extern sexp* rlang_new_quosure(sexp*, sexp*); extern sexp* rlang_poke_attributes(sexp*, sexp*); extern sexp* rlang_enexpr(sexp*, sexp*); extern sexp* rlang_ensym(sexp*, sexp*); extern sexp* rlang_enquo(sexp*, sexp*); extern sexp* rlang_get_expression(sexp*, sexp*); extern sexp* rlang_vec_coerce(sexp*, sexp*); extern sexp* rlang_mark_object(sexp*); extern sexp* rlang_unmark_object(sexp*); extern sexp* rlang_quo_is_missing(sexp*); extern sexp* rlang_quo_is_symbol(sexp*); extern sexp* rlang_quo_is_call(sexp*); extern sexp* rlang_quo_is_symbolic(sexp*); extern sexp* rlang_quo_is_null(sexp*); extern sexp* rlang_vec_poke_n(sexp*, sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_vec_poke_range(sexp*, sexp*, sexp*, sexp*, sexp*); extern sexp* rlang_quo_get_expr(sexp*); extern sexp* rlang_quo_set_expr(sexp*, sexp*); extern sexp* rlang_quo_get_env(sexp*); extern sexp* rlang_quo_set_env(sexp*, sexp*); extern sexp* rlang_which_operator(sexp*); extern sexp* rlang_new_data_mask(sexp*, sexp*, sexp*); extern sexp* rlang_as_data_mask(sexp*, sexp*); extern sexp* rlang_data_mask_clean(sexp*); extern sexp* rlang_eval_tidy(sexp*, sexp*, sexp*); extern sexp* rlang_as_data_pronoun(sexp*); // Library initialisation defined below sexp* rlang_library_load(); sexp* rlang_library_unload(); // For unit tests extern sexp* chr_prepend(sexp*, sexp*); extern sexp* chr_append(sexp*, sexp*); extern sexp* rlang_test_r_warn(sexp*); extern sexp* rlang_on_exit(sexp*, sexp*); extern sexp* rlang_test_is_special_op_sym(sexp*); extern sexp* rlang_test_base_ns_get(sexp*); extern sexp* r_current_frame(); extern sexp* rlang_test_sys_frame(sexp*); extern sexp* rlang_test_sys_call(sexp*); extern sexp* new_tilde_thunk(sexp*, sexp*); static const r_callable r_callables[] = { {"rlang_library_load", (r_fn_ptr_t) &rlang_library_load, 0}, {"rlang_library_unload", (r_fn_ptr_t) &rlang_library_unload, 0}, {"r_f_lhs", (r_fn_ptr_t) &r_f_lhs, 1}, {"r_f_rhs", (r_fn_ptr_t) &r_f_rhs, 1}, {"rlang_new_condition", (r_fn_ptr_t) &r_new_condition, 3}, {"rlang_replace_na", (r_fn_ptr_t) &rlang_replace_na, 2}, {"rlang_capturearginfo", (r_fn_ptr_t) &rlang_capturearginfo, 4}, {"rlang_capturedots", (r_fn_ptr_t) &rlang_capturedots, 4}, {"rlang_duplicate", (r_fn_ptr_t) &rlang_duplicate, 2}, {"rlang_node_tree_clone", (r_fn_ptr_t) &r_node_tree_clone, 1}, {"rlang_eval", (r_fn_ptr_t) &rlang_eval, 2}, {"rlang_get_attrs", (r_fn_ptr_t) &rlang_get_attrs, 1}, {"rlang_interp", (r_fn_ptr_t) &rlang_interp, 2}, {"rlang_is_formulaish", (r_fn_ptr_t) &rlang_is_formulaish, 3}, {"rlang_is_null", (r_fn_ptr_t) &rlang_is_null, 1}, {"rlang_is_reference", (r_fn_ptr_t) &rlang_is_reference, 2}, {"rlang_length", (r_fn_ptr_t) &rlang_length, 1}, {"rlang_true_length", (r_fn_ptr_t) &rlang_true_length, 1}, {"rlang_new_data_pronoun", (r_fn_ptr_t) &rlang_new_data_pronoun, 3}, {"rlang_set_attrs", (r_fn_ptr_t) &rlang_set_attrs, 2}, {"rlang_missing_arg", (r_fn_ptr_t) &rlang_missing_arg, 0}, {"rlang_node_car", (r_fn_ptr_t) &rlang_node_car, 1}, {"rlang_node_cdr", (r_fn_ptr_t) &rlang_node_cdr, 1}, {"rlang_node_caar", (r_fn_ptr_t) &rlang_node_caar, 1}, {"rlang_node_cadr", (r_fn_ptr_t) &rlang_node_cadr, 1}, {"rlang_node_cdar", (r_fn_ptr_t) &rlang_node_cdar, 1}, {"rlang_node_cddr", (r_fn_ptr_t) &rlang_node_cddr, 1}, {"rlang_node_poke_car", (r_fn_ptr_t) &rlang_node_poke_car, 2}, {"rlang_node_poke_cdr", (r_fn_ptr_t) &rlang_node_poke_cdr, 2}, {"rlang_node_poke_caar", (r_fn_ptr_t) &rlang_node_poke_caar, 2}, {"rlang_node_poke_cadr", (r_fn_ptr_t) &rlang_node_poke_cadr, 2}, {"rlang_node_poke_cdar", (r_fn_ptr_t) &rlang_node_poke_cdar, 2}, {"rlang_node_poke_cddr", (r_fn_ptr_t) &rlang_node_poke_cddr, 2}, {"rlang_new_node", (r_fn_ptr_t) &rlang_new_node_, 2}, {"rlang_env_clone", (r_fn_ptr_t) &r_env_clone, 2}, {"rlang_env_unbind", (r_fn_ptr_t) &rlang_env_unbind, 3}, {"rlang_env_poke_parent", (r_fn_ptr_t) &rlang_env_poke_parent, 2}, {"rlang_env_frame", (r_fn_ptr_t) &rlang_env_frame, 1}, {"rlang_env_hash_table", (r_fn_ptr_t) &rlang_env_hash_table, 1}, {"rlang_poke_type", (r_fn_ptr_t) &rlang_poke_type, 2}, {"rlang_mark_object", (r_fn_ptr_t) &rlang_mark_object, 1}, {"rlang_unmark_object", (r_fn_ptr_t) &rlang_unmark_object, 1}, {"rlang_node_tag", (r_fn_ptr_t) &rlang_node_tag, 1}, {"rlang_node_poke_tag", (r_fn_ptr_t) &rlang_node_poke_tag, 2}, {"rlang_squash", (r_fn_ptr_t) &rlang_squash, 4}, {"rlang_sxp_address", (r_fn_ptr_t) &rlang_sxp_address, 1}, {"rlang_symbol", (r_fn_ptr_t) &rlang_symbol, 1}, {"rlang_symbol_to_character", (r_fn_ptr_t) &rlang_symbol_to_character, 1}, {"rlang_tilde_eval", (r_fn_ptr_t) &rlang_tilde_eval, 4}, {"rlang_unescape_character", (r_fn_ptr_t) &rlang_unescape_character, 1}, {"rlang_zap_attrs", (r_fn_ptr_t) &rlang_zap_attrs, 1}, {"rlang_new_call", (r_fn_ptr_t) &rlang_new_call_node, 2}, {"rlang_cnd_abort", (r_fn_ptr_t) &rlang_cnd_abort, 2}, {"rlang_cnd_inform", (r_fn_ptr_t) &rlang_cnd_inform, 2}, {"rlang_cnd_signal", (r_fn_ptr_t) &rlang_cnd_signal, 2}, {"rlang_cnd_warn", (r_fn_ptr_t) &rlang_cnd_warn, 2}, {"rlang_test_chr_prepend", (r_fn_ptr_t) &chr_prepend, 2}, {"rlang_test_chr_append", (r_fn_ptr_t) &chr_append, 2}, {"rlang_test_r_warn", (r_fn_ptr_t) &rlang_test_r_warn, 1}, {"rlang_test_r_on_exit", (r_fn_ptr_t) &rlang_on_exit, 2}, {"rlang_test_is_special_op_sym", (r_fn_ptr_t) &rlang_test_is_special_op_sym, 1}, {"rlang_test_base_ns_get", (r_fn_ptr_t) &rlang_test_base_ns_get, 1}, {"rlang_test_current_frame", (r_fn_ptr_t) &r_current_frame, 0}, {"rlang_test_sys_frame", (r_fn_ptr_t) &rlang_test_sys_frame, 1}, {"rlang_test_sys_call", (r_fn_ptr_t) &rlang_test_sys_call, 1}, {"rlang_new_tilde_thunk", (r_fn_ptr_t) &new_tilde_thunk, 2}, {"rlang_r_string", (r_fn_ptr_t) &rlang_r_string, 1}, {"rlang_exprs_interp", (r_fn_ptr_t) &rlang_exprs_interp, 4}, {"rlang_quos_interp", (r_fn_ptr_t) &rlang_quos_interp, 4}, {"rlang_dots_values", (r_fn_ptr_t) &rlang_dots_values, 4}, {"rlang_dots_list", (r_fn_ptr_t) &rlang_dots_list, 4}, {"rlang_dots_flat_list", (r_fn_ptr_t) &rlang_dots_flat_list, 4}, {"rlang_new_formula", (r_fn_ptr_t) &r_new_formula, 3}, {"rlang_new_quosure", (r_fn_ptr_t) &rlang_new_quosure, 2}, {"rlang_poke_attributes", (r_fn_ptr_t) &rlang_poke_attributes, 2}, {"rlang_enexpr", (r_fn_ptr_t) &rlang_enexpr, 2}, {"rlang_ensym", (r_fn_ptr_t) &rlang_ensym, 2}, {"rlang_enquo", (r_fn_ptr_t) &rlang_enquo, 2}, {"rlang_get_expression", (r_fn_ptr_t) &rlang_get_expression, 2}, {"rlang_vec_coerce", (r_fn_ptr_t) &rlang_vec_coerce, 2}, {"rlang_quo_is_symbol", (r_fn_ptr_t) &rlang_quo_is_symbol, 1}, {"rlang_quo_is_call", (r_fn_ptr_t) &rlang_quo_is_call, 1}, {"rlang_quo_is_symbolic", (r_fn_ptr_t) &rlang_quo_is_symbolic, 1}, {"rlang_quo_is_missing", (r_fn_ptr_t) &rlang_quo_is_missing, 1}, {"rlang_quo_is_null", (r_fn_ptr_t) &rlang_quo_is_null, 1}, {"rlang_quo_get_expr", (r_fn_ptr_t) &rlang_quo_get_expr, 1}, {"rlang_quo_set_expr", (r_fn_ptr_t) &rlang_quo_set_expr, 2}, {"rlang_quo_get_env", (r_fn_ptr_t) &rlang_quo_get_env, 1}, {"rlang_quo_set_env", (r_fn_ptr_t) &rlang_quo_set_env, 2}, {"rlang_vec_poke_n", (r_fn_ptr_t) &rlang_vec_poke_n, 5}, {"rlang_vec_poke_range", (r_fn_ptr_t) &rlang_vec_poke_range, 5}, {"rlang_which_operator", (r_fn_ptr_t) &rlang_which_operator, 1}, {"rlang_call_has_precedence", (r_fn_ptr_t) &rlang_call_has_precedence, 3}, {"rlang_new_data_mask", (r_fn_ptr_t) &rlang_new_data_mask, 3}, {"rlang_as_data_mask", (r_fn_ptr_t) &rlang_as_data_mask, 2}, {"rlang_data_mask_clean", (r_fn_ptr_t) &rlang_data_mask_clean, 1}, {"rlang_eval_tidy", (r_fn_ptr_t) &rlang_eval_tidy, 3}, {"rlang_as_data_pronoun", (r_fn_ptr_t) &rlang_as_data_pronoun, 1}, {NULL, NULL, 0} }; void R_init_rlang(r_dll_info* dll) { /* r_register_c_callable("rlang", "rlang_new_data_pronoun", (r_fn_ptr_t) &rlang_new_dictionary); */ r_register_c_callable("rlang", "rlang_squash_if", (r_fn_ptr_t) &r_squash_if); // The quosure functions are stable r_register_c_callable("rlang", "rlang_new_quosure", (r_fn_ptr_t) &rlang_new_quosure); r_register_c_callable("rlang", "rlang_is_quosure", (r_fn_ptr_t) &rlang_is_quosure); r_register_c_callable("rlang", "rlang_quo_get_expr", (r_fn_ptr_t) &rlang_quo_get_expr); r_register_c_callable("rlang", "rlang_quo_set_expr", (r_fn_ptr_t) &rlang_quo_set_expr); r_register_c_callable("rlang", "rlang_quo_get_env", (r_fn_ptr_t) &rlang_quo_get_env); r_register_c_callable("rlang", "rlang_quo_set_env", (r_fn_ptr_t) &rlang_quo_set_env); // The data mask functions are stable r_register_c_callable("rlang", "rlang_as_data_pronoun", (r_fn_ptr_t) &rlang_as_data_pronoun); r_register_c_callable("rlang", "rlang_as_data_mask", (r_fn_ptr_t) &rlang_as_data_mask); r_register_c_callable("rlang", "rlang_new_data_mask", (r_fn_ptr_t) &rlang_new_data_mask); // Experimental method for exporting C function pointers as actual R objects rlang_register_pointer("rlang", "rlang_test_is_spliceable", (r_fn_ptr_t) &rlang_is_clevel_spliceable); r_register_r_callables(dll, r_callables); } // From "../internal/internal.h" void rlang_init_internal(); sexp* rlang_library_load() { r_init_library(); rlang_init_internal(); return r_null; } sexp* rlang_library_unload() { return r_null; } rlang/src/export.c0000644000176200001440000000013113242736425013634 0ustar liggesusers#include "export/exported.c" #include "export/exported-tests.c" #include "export/init.c" rlang/src/capture.c0000644000176200001440000000624213242736425013767 0ustar liggesusers#include #define attribute_hidden #define _(string) (string) SEXP attribute_hidden new_captured_arg(SEXP x, SEXP env) { static SEXP nms = NULL; if (!nms) { nms = allocVector(STRSXP, 2); R_PreserveObject(nms); MARK_NOT_MUTABLE(nms); SET_STRING_ELT(nms, 0, mkChar("expr")); SET_STRING_ELT(nms, 1, mkChar("env")); } SEXP info = PROTECT(allocVector(VECSXP, 2)); SET_VECTOR_ELT(info, 0, x); SET_VECTOR_ELT(info, 1, env); setAttrib(info, R_NamesSymbol, nms); UNPROTECT(1); return info; } SEXP attribute_hidden new_captured_literal(SEXP x) { return new_captured_arg(x, R_EmptyEnv); } SEXP attribute_hidden new_captured_promise(SEXP x, SEXP env) { SEXP expr_env = R_NilValue; SEXP expr = x; while (TYPEOF(expr) == PROMSXP) { expr_env = PRENV(expr); expr = PREXPR(expr); } // Evaluated arguments are returned as literals if (expr_env == R_NilValue) { SEXP value = PROTECT(eval(x, env)); expr = new_captured_literal(value); UNPROTECT(1); } else { MARK_NOT_MUTABLE(expr); expr = new_captured_arg(expr, expr_env); } return expr; } SEXP attribute_hidden rlang_capturearginfo(SEXP call, SEXP op, SEXP args, SEXP rho) { // Unwrap first layer of promise SEXP sym = findVarInFrame3(rho, install("x"), TRUE); // May be a literal if compiler did not wrap in a promise if (TYPEOF(sym) == PROMSXP) sym = PREXPR(sym); else return new_captured_literal(sym); if (TYPEOF(sym) != SYMSXP) error(_("\"x\" must be an argument name")); SEXP frame = CAR(args); SEXP arg = findVar(sym, frame); if (arg == R_UnboundValue) error(_("object '%s' not found"), CHAR(PRINTNAME(sym))); if (arg == R_MissingArg) return new_captured_literal(arg); else if (TYPEOF(arg) == PROMSXP) return new_captured_promise(arg, frame); else return new_captured_literal(arg); } SEXP capturedots(SEXP frame) { SEXP dots = PROTECT(findVar(R_DotsSymbol, frame)); if (dots == R_UnboundValue) { error(_("Must capture dots in a function where dots exist")); } if (dots == R_MissingArg) { UNPROTECT(1); return allocVector(VECSXP, 0); } int n_dots = length(dots); SEXP captured = PROTECT(allocVector(VECSXP, n_dots)); SEXP names = PROTECT(allocVector(STRSXP, n_dots)); Rboolean named = FALSE; int i = 0; while (dots != R_NilValue) { SEXP head = CAR(dots); SEXP dot; if (TYPEOF(head) == PROMSXP) dot = new_captured_promise(head, frame); else dot = new_captured_literal(head); SET_VECTOR_ELT(captured, i, dot); if (TAG(dots) != R_NilValue) { named = TRUE; SET_STRING_ELT(names, i, PRINTNAME(TAG(dots))); } ++i; dots = CDR(dots); } if (named) setAttrib(captured, R_NamesSymbol, names); UNPROTECT(3); return captured; } SEXP attribute_hidden rlang_capturedots(SEXP call, SEXP op, SEXP args, SEXP rho) { SEXP caller_env = CAR(args); return capturedots(caller_env); } rlang/src/internal.c0000644000176200001440000000036513242736425014140 0ustar liggesusers#include "internal/arg.c" #include "internal/dots.c" #include "internal/eval-tidy.c" #include "internal/expr-interp.c" #include "internal/expr-interp-rotate.c" #include "internal/internal.c" #include "internal/quo.c" #include "internal/utils.c" rlang/NAMESPACE0000644000176200001440000002156313241233650012602 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",rlang_data_pronoun) S3method("$<-",rlang_data_pronoun) S3method("[",quosures) S3method("[",stack) S3method("[[",rlang_data_pronoun) S3method("[[<-",rlang_data_pronoun) S3method(as_dictionary,"NULL") S3method(as_dictionary,data.frame) S3method(as_dictionary,default) S3method(as_dictionary,dictionary) S3method(as_dictionary,environment) S3method(c,quosures) S3method(length,rlang_data_pronoun) S3method(names,rlang_data_pronoun) S3method(print,frame) S3method(print,quosure) S3method(print,quosures) S3method(print,rlang_data_pronoun) S3method(rst_muffle,default) S3method(rst_muffle,mufflable) S3method(rst_muffle,simpleMessage) S3method(rst_muffle,simpleWarning) S3method(str,quosure) S3method(str,rlang_data_pronoun) export("!!!") export("!!") export("%@%") export("%|%") export("%||%") export(":=") export("f_env<-") export("f_lhs<-") export("f_rhs<-") export("fn_body<-") export("fn_env<-") export("fn_fmls<-") export("fn_fmls_names<-") export(.data) export(UQ) export(UQE) export(UQS) export(abort) export(are_na) export(arg_match) export(as_box) export(as_box_if) export(as_bytes) export(as_character) export(as_closure) export(as_complex) export(as_data_mask) export(as_data_pronoun) export(as_dictionary) export(as_double) export(as_env) export(as_environment) export(as_function) export(as_integer) export(as_list) export(as_logical) export(as_native_character) export(as_native_string) export(as_overscope) export(as_pairlist) export(as_quosure) export(as_quosureish) export(as_string) export(as_utf8_character) export(as_utf8_string) export(base_env) export(bytes) export(bytes_along) export(bytes_len) export(call2) export(call_args) export(call_args_names) export(call_depth) export(call_fn) export(call_frame) export(call_inspect) export(call_modify) export(call_name) export(call_stack) export(call_standardise) export(caller_env) export(caller_fn) export(caller_frame) export(catch_cnd) export(child_env) export(chr) export(chr_along) export(chr_encoding) export(chr_len) export(chr_unserialise_unicode) export(cnd) export(cnd_abort) export(cnd_error) export(cnd_inform) export(cnd_message) export(cnd_signal) export(cnd_warn) export(cnd_warning) export(coerce_class) export(coerce_lang) export(coerce_type) export(cpl) export(cpl_along) export(cpl_len) export(ctxt_depth) export(ctxt_frame) export(ctxt_stack) export(current_frame) export(dbl) export(dbl_along) export(dbl_len) export(dots_definitions) export(dots_list) export(dots_n) export(dots_splice) export(dots_values) export(duplicate) export(empty_env) export(enexpr) export(enexprs) export(enquo) export(enquos) export(ensym) export(ensyms) export(env) export(env_bind) export(env_bind_exprs) export(env_bind_fns) export(env_bury) export(env_clone) export(env_depth) export(env_get) export(env_get_list) export(env_has) export(env_inherits) export(env_names) export(env_parent) export(env_parents) export(env_poke) export(env_poke_parent) export(env_tail) export(env_unbind) export(error_cnd) export(eval_bare) export(eval_tidy) export(eval_tidy_) export(exiting) export(expr) export(expr_deparse) export(expr_interp) export(expr_label) export(expr_name) export(expr_print) export(expr_text) export(exprs) export(exprs_auto_name) export(f_env) export(f_label) export(f_lhs) export(f_name) export(f_rhs) export(f_text) export(flatten) export(flatten_chr) export(flatten_cpl) export(flatten_dbl) export(flatten_if) export(flatten_int) export(flatten_lgl) export(flatten_raw) export(fn_body) export(fn_env) export(fn_fmls) export(fn_fmls_names) export(fn_fmls_syms) export(frame_position) export(friendly_type) export(get_env) export(get_expr) export(global_env) export(global_frame) export(has_length) export(has_name) export(have_name) export(inform) export(inherits_all) export(inherits_any) export(inherits_only) export(inplace) export(int) export(int_along) export(int_len) export(invoke) export(is_atomic) export(is_bare_atomic) export(is_bare_bytes) export(is_bare_character) export(is_bare_double) export(is_bare_env) export(is_bare_formula) export(is_bare_integer) export(is_bare_integerish) export(is_bare_list) export(is_bare_logical) export(is_bare_numeric) export(is_bare_raw) export(is_bare_string) export(is_bare_vector) export(is_binary_lang) export(is_box) export(is_bytes) export(is_call) export(is_call_stack) export(is_callable) export(is_character) export(is_chr_na) export(is_closure) export(is_condition) export(is_copyable) export(is_cpl_na) export(is_dbl_na) export(is_definition) export(is_dictionary) export(is_dictionaryish) export(is_double) export(is_empty) export(is_env) export(is_eval_stack) export(is_expr) export(is_expression) export(is_false) export(is_formula) export(is_formulaish) export(is_frame) export(is_function) export(is_installed) export(is_int_na) export(is_integer) export(is_integerish) export(is_lang) export(is_lgl_na) export(is_list) export(is_logical) export(is_missing) export(is_na) export(is_named) export(is_namespace) export(is_node) export(is_node_list) export(is_null) export(is_pairlist) export(is_primitive) export(is_primitive_eager) export(is_primitive_lazy) export(is_quosure) export(is_quosureish) export(is_quosures) export(is_raw) export(is_reference) export(is_scalar_atomic) export(is_scalar_bytes) export(is_scalar_character) export(is_scalar_double) export(is_scalar_integer) export(is_scalar_integerish) export(is_scalar_list) export(is_scalar_logical) export(is_scalar_raw) export(is_scalar_vector) export(is_scoped) export(is_spliced) export(is_spliced_bare) export(is_stack) export(is_string) export(is_symbol) export(is_symbolic) export(is_syntactic_literal) export(is_true) export(is_unary_lang) export(is_vector) export(lang) export(lang_args) export(lang_args_names) export(lang_fn) export(lang_head) export(lang_modify) export(lang_name) export(lang_standardise) export(lang_tail) export(lang_type_of) export(lgl) export(lgl_along) export(lgl_len) export(list2) export(list_along) export(list_len) export(ll) export(locally) export(maybe_missing) export(message_cnd) export(missing_arg) export(modify) export(mut_attrs) export(mut_latin1_locale) export(mut_mbcs_locale) export(mut_node_caar) export(mut_node_cadr) export(mut_node_car) export(mut_node_cdar) export(mut_node_cddr) export(mut_node_cdr) export(mut_node_tag) export(mut_utf8_locale) export(na_chr) export(na_cpl) export(na_dbl) export(na_int) export(na_lgl) export(names2) export(new_box) export(new_call) export(new_character) export(new_character_along) export(new_cnd) export(new_complex) export(new_complex_along) export(new_data_mask) export(new_definition) export(new_double) export(new_double_along) export(new_environment) export(new_formula) export(new_function) export(new_integer) export(new_integer_along) export(new_language) export(new_list) export(new_list_along) export(new_logical) export(new_logical_along) export(new_node) export(new_overscope) export(new_quosure) export(new_raw) export(new_raw_along) export(node) export(node_caar) export(node_cadr) export(node_car) export(node_cdar) export(node_cddr) export(node_cdr) export(node_poke_caar) export(node_poke_cadr) export(node_poke_car) export(node_poke_cdar) export(node_poke_cddr) export(node_poke_cdr) export(node_poke_tag) export(node_tag) export(ns_env) export(ns_env_name) export(ns_imports_env) export(overscope_clean) export(overscope_eval_next) export(parse_expr) export(parse_exprs) export(parse_quo) export(parse_quos) export(parse_quosure) export(parse_quosures) export(peek_option) export(peek_options) export(pkg_env) export(pkg_env_name) export(prepend) export(prim_name) export(push_options) export(qq_show) export(quo) export(quo_expr) export(quo_get_env) export(quo_get_expr) export(quo_is_call) export(quo_is_lang) export(quo_is_missing) export(quo_is_null) export(quo_is_symbol) export(quo_is_symbolic) export(quo_label) export(quo_name) export(quo_set_env) export(quo_set_expr) export(quo_squash) export(quo_text) export(quos) export(quos_auto_name) export(raw_along) export(raw_len) export(rep_along) export(restarting) export(return_from) export(return_to) export(rst_abort) export(rst_exists) export(rst_jump) export(rst_list) export(rst_maybe_jump) export(rst_muffle) export(scoped_bindings) export(scoped_env) export(scoped_envs) export(scoped_names) export(scoped_options) export(seq2) export(seq2_along) export(set_attrs) export(set_chr_encoding) export(set_env) export(set_expr) export(set_names) export(set_str_encoding) export(splice) export(squash) export(squash_chr) export(squash_cpl) export(squash_dbl) export(squash_if) export(squash_int) export(squash_lgl) export(squash_raw) export(stack_trim) export(str_encoding) export(string) export(switch_class) export(switch_lang) export(switch_type) export(sym) export(syms) export(type_of) export(unbox) export(vec_poke_n) export(vec_poke_range) export(warn) export(warning_cnd) export(with_bindings) export(with_env) export(with_handlers) export(with_options) export(with_restarts) importFrom(utils,str) useDynLib(rlang, .registration = TRUE) rlang/NEWS.md0000644000176200001440000004561713242734315012474 0ustar liggesusers # rlang 0.2.0 This release of rlang is mostly an effort at polishing the tidy evaluation framework. All tidy eval functions and operators have been rewritten in C in order to improve performance. Capture of expression, quasiquotation, and evaluation of quosures are now vastly faster. On the UI side, many of the inconveniences that affected the first release of rlang have been solved: * The `!!` operator now has the precedence of unary `+` and `-` which allows a much more natural syntax: `!!a > b` only unquotes `a` rather than the whole `a > b` expression. * `enquo()` works in magrittr pipes: `mtcars %>% select(!!enquo(var))`. * `enquos()` is a variant of `quos()` that has a more natural interface for capturing multiple arguments and `...`. See the first section below for a complete list of changes to the tidy evaluation framework. This release also polishes the rlang API. Many functions have been renamed as we get a better feel for the consistency and clarity of the API. Note that rlang as a whole is still maturing and some functions are even experimental. In order to make things clearer for users of rlang, we have started to develop a set of conventions to document the current stability of each function. You will now find "lifecycle" sections in documentation topics. In addition we have gathered all lifecycle information in the `?rlang::lifecycle` help page. Please only use functions marked as stable in your projects unless you are prepared to deal with occasional backward incompatible updates. ## Tidy evaluation * The backend for `quos()`, `exprs()`, `list2()`, `dots_list()`, etc is now written in C. This greatly improve the performance of dots capture, especially with the splicing operator `!!!` which now scales much better (you'll see a 1000x performance gain in some cases). The unquoting algorithm has also been improved which makes `enexpr()` and `enquo()` more efficient as well. * The tidy eval `!!` operator now binds tightly. You no longer have to wrap it in parentheses, i.e. `!!x > y` will only unquote `x`. Technically the `!!` operator has the same precedence as unary `-` and `+`. This means that `!!a:b` and `!!a + b` are equivalent to `(!!a):b` and `(!!a) + b`. On the other hand `!!a^b` and `!!a$b` are equivalent to`!!(a^b)` and `!!(a$b)`. * The print method for quosures has been greatly improved. Quosures no longer appear as formulas but as expressions prefixed with `^`; quosures are colourised according to their environment; unquoted objects are displayed between angular brackets instead of code (i.e. an unquoted integer vector is shown as `` rather than `1:2`); unquoted S3 objects are displayed using `pillar::type_sum()` if available. * New `enquos()` function to capture arguments. It treats `...` the same way as `quos()` but can also capture named arguments just like `enquo()`, i.e. one level up. By comparison `quos(arg)` only captures the name `arg` rather than the expression supplied to the `arg` argument. In addition, `enexprs()` is like `enquos()` but like `exprs()` it returns bare expressions. And `ensyms()` expects strings or symbols. * It is now possible to use `enquo()` within a magrittr pipe: ``` select_one <- function(df, var) { df %>% dplyr::select(!!enquo(var)) } ``` Technically, this is because `enquo()` now also captures arguments in parents of the current environment rather than just in the current environment. The flip side of this increased flexibility is that if you made a typo in the name of the variable you want to capture, and if an object of that name exists anywhere in the parent contexts, you will capture that object rather than getting an error. * `quo_expr()` has been renamed to `quo_squash()` in order to better reflect that it is a lossy operation that flattens all nested quosures. * `!!!` now accepts any kind of objects for consistency. Scalar types are treated as vectors of length 1. Previously only symbolic objects like symbols and calls were treated as such. * `ensym()` is a new variant of `enexpr()` that expects a symbol or a string and always returns a symbol. If a complex expression is supplied it fails with an error. * `exprs()` and `quos()` gain a `.unquote_names` arguments to switch off interpretation of `:=` as a name operator. This should be useful for programming on the language targetting APIs such as data.table. * `exprs()` gains a `.named` option to auto-label its arguments (#267). * Functions taking dots by value rather than by expression (e.g. regular functions, not quoting functions) have a more restricted set of unquoting operations. They only support `:=` and `!!!`, and only at top-level. I.e. `dots_list(!!! x)` is valid but not `dots_list(nested_call(!!! x))` (#217). * Functions taking dots with `list2()` or `dots_list()` now support splicing of `NULL` values. `!!! NULL` is equivalent to `!!! list()` (#242). * Capture operators now support evaluated arguments. Capturing a forced or evaluated argument is exactly the same as unquoting that argument: the actual object (even if a vector) is inlined in the expression. Capturing a forced argument occurs when you use `enquo()`, `enexpr()`, etc too late. It also happens when your quoting function is supplied to `lapply()` or when you try to quote the first argument of an S3 method (which is necessarily evaluated in order to detect which class to dispatch to). (#295, #300). * Parentheses around `!!` are automatically removed. This makes the generated expression call cleaner: `(!! sym("name"))(arg)`. Note that removing the parentheses will never affect the actual precedence within the expression as the parentheses are only useful when parsing code as text. The parentheses will also be added by R when printing code if needed (#296). * Quasiquotation now supports `!!` and `!!!` as functional forms: ``` expr(`!!`(var)) quo(call(`!!!`(var))) ``` This is consistent with the way native R operators parses to function calls. These new functional forms are to be preferred to `UQ()` and `UQS()`. We are now questioning the latter and might deprecate them in a future release. * The quasiquotation parser now gives meaningful errors in corner cases to help you figure out what is wrong. * New getters and setters for quosures: `quo_get_expr()`, `quo_get_env()`, `quo_set_expr()`, and `quo_set_env()`. Compared to `get_expr()` etc, these accessors only work on quosures and are slightly more efficient. * `quo_is_symbol()` and `quo_is_call()` now take the same set of arguments as `is_symbol()` and `is_call()`. * `enquo()` and `enexpr()` now deal with default values correctly (#201). * Splicing a list no longer mutates it (#280). ## Conditions * The new functions `cnd_warn()` and `cnd_inform()` transform conditions to warnings or messages before signalling them. * `cnd_signal()` now returns invisibly. * `cnd_signal()` and `cnd_abort()` now accept character vectors to create typed conditions with several S3 subclasses. * `is_condition()` is now properly exported. * Condition signallers such as `cnd_signal()` and `abort()` now accept a call depth as `call` arguments. This allows plucking a call from further up the call stack (#30). * New helper `catch_cnd()`. This is a small wrapper around `tryCatch()` that captures and returns any signalled condition. It returns `NULL` if none was signalled. * `cnd_abort()` now adds the correct S3 classes for error conditions. This fixes error catching, for instance by `testthat::expect_error()`. ## Environments * `env_get_list()` retrieves muliple bindings from an environment into a named list. * `with_bindings()` and `scoped_bindings()` establish temporary bindings in an environment. * `is_namespace()` is a snake case wrapper around `isNamespace()`. ## Various features * New functions `inherits_any()`, `inherits_all()`, and `inherits_only()`. They allow testing for inheritance from multiple classes. The `_any` variant is equivalent to `base::inherits()` but is more explicit about its behaviour. `inherits_all()` checks that all classes are present in order and `inherits_only()` checks that the class vectors are identical. * New `fn_fmls<-` and `fn_fmls_names<-` setters. * New function experimental function `chr_unserialise_unicode()` for turning characters serialised to unicode point form (e.g. ``) to UTF-8. In addition, `as_utf8_character()` now translates those as well. (@krlmlr) * `expr_label()` now supports quoted function definition calls (#275). * `call_modify()` and `call_standardise()` gain an argument to specify an environment. The call definition is looked up in that environment when the call to modify or standardise is not wrapped in a quosure. * `is_symbol()` gains a `name` argument to check that that the symbol name matches a string (#287). * New `rlang_box` class. Its purpose is similar to the `AsIs` class from `base::I()`, i.e. it protects a value temporarily. However it does so by wrapping the value in a scalar list. Use `new_box()` to create a boxed value, `is_box()` to test for a boxed value, and `unbox()` to unbox it. `new_box()` and `is_box()` accept optional subclass. * The vector constructors such as `new_integer()`, `new_double_along()` etc gain a `names` argument. In the case of the `_along` family it defaults to the names of the input vector. ## Bugfixes * When nested quosures are evaluated with `eval_tidy()`, the `.env` pronoun now correctly refers to the current quosure under evaluation (#174). Previously it would always refer to the environment of the outermost quosure. * `as_pairlist()` (part of the experimental API) now supports `NULL` and objects of type pairlist (#397). * Fixed a performance bug in `set_names()` that caused a full copy of the vector names (@jimhester, #366). ## API changes The rlang API is maturing and still in flux. However we have made an effort to better communicate what parts are stable. We will not introduce breaking changes for stable functions unless the payoff for the change is worth the trouble. See `?rlang::lifecycle` for the lifecycle status of exported functions. * The particle "lang" has been renamed to "call": - `lang()` has been renamed to `call2()`. - `new_language()` has ben renamed to `new_call()`. - `is_lang()` has been renamed to `is_call()`. We haven't replaced the `is_unary_lang()` and `is_binary_lang()` because they are redundant with the `n` argument of `is_call()`. - All call accessors such as `lang_fn()`, `lang_name()`, `lang_args()` etc are soft-deprecated and renamed with `call_` prefix. In rlang 0.1 calls were called "language" objects in order to follow the R type nomenclature as returned by `base::typeof()`. We wanted to avoid adding to the confusion between S modes and R types. With hindsight we find it is better to use more meaningful type names. * We now use the term "data mask" instead of "overscope". We think data mask is a more natural name in the context of R. We say that that objects from user data mask objects in the current environment. This makes reference to object masking in the search path which is due to the same mechanism (in technical terms, lexical scoping with hierarchically nested environments). Following this new terminology, the new functions `as_data_mask()` and `new_data_mask()` replace `as_overscope()` and `new_overscope()`. `as_data_mask()` has also a more consistent interface. These functions are only meant for developers of tidy evaluation interfaces. * We no longer require a data mask (previously called overscope) to be cleaned up after evaluation. `overscope_clean()` is thus soft-deprecated without replacement. ### Breaking changes * `!!` now binds tightly in order to match intuitive parsing of tidy eval code, e.g. `!! x > y` is now equivalent to `(!! x) > y`. A corollary of this new syntax is that you now have to be explicit when you want to unquote the whole expression on the right of `!!`. For instance you have to explicitly write `!! (x > y)` to unquote `x > y` rather than just `x`. * `UQ()`, `UQS()` and `:=` now issue an error when called directly. The previous definitions caused surprising results when the operators were invoked in wrong places (i.e. not in quasiquoted arguments). * The prefix form `` `!!`() `` is now an alias to `!!` rather than `UQE()`. This makes it more in line with regular R syntax where operators are parsed as regular calls, e.g. `a + b` is parsed as `` `+`(a, b) `` and both forms are completely equivalent. Also the prefix form `` `!!!`() `` is now equivalent to `!!!`. * `UQE()` is now deprecated in order to simplify the syntax of quasiquotation. Please use `!! get_expr(x)` instead. * `expr_interp()` now returns a formula instead of a quosure when supplied a formula. * `is_quosureish()` and `as_quosureish()` are deprecated. These functions assumed that quosures are formulas but that is only an implementation detail. * `new_cnd()` is now `cnd()` for consistency with other constructors. Also, `cnd_error()`, `cnd_warning()` and `cnd_message()` are now `error_cnd()`, `warning_cnd()` and `message_cnd()` to follow our naming scheme according to which the type of output is a suffix rather than a prefix. * `is_node()` now returns `TRUE` for calls as well and `is_pairlist()` does not return `TRUE` for `NULL` objects. Use `is_node_list()` to determine whether an object either of type `pairlist` or `NULL`. Note that all these functions are still experimental. * `set_names()` no longer automatically splices lists of character vectors as we are moving away from automatic splicing semantics. ### Upcoming breaking changes * Calling the functional forms of unquote operators with the rlang namespace qualifier is soft-deprecated. `UQ()` and `UQS()` are not function calls so it does not make sense to namespace them. Supporting namespace qualifiers complicates the implementation of unquotation and is misleading as to the nature of unquoting (which are syntactic operators at quotation-time rather than function calls at evaluation-time). * We are now questioning `UQ()` and `UQS()` as functional forms of `!!`. If `!!` and `!!!` were native R operators, they would parse to the functional calls `` `!!`() `` and `` `!!!`() ``. This is now the preferred way to unquote with a function call rather than with the operators. We haven't decided yet whether we will deprecate `UQ()` and `UQS()` in the future. In any case we recommend using the new functional forms. * `parse_quosure()` and `parse_quosures()` are soft-deprecated in favour of `parse_quo()` and `parse_quos()`. These new names are consistent with the rule that abbreviated suffixes indicate the return type of a function. In addition the new functions require their callers to explicitly supply an environment for the quosures. * Using `f_rhs()` and `f_env()` on quosures is soft-deprecated. The fact that quosures are formulas is an implementation detail that might change in the future. Please use `quo_get_expr()` and `quo_get_env()` instead. * `quo_expr()` is soft-deprecated in favour of `quo_squash()`. `quo_expr()` was a misnomer because it implied that it was a mere expression acccessor for quosures whereas it was really a lossy operation that squashed all nested quosures. * With the renaming of the `lang` particle to `call`, all these functions are soft-deprecated: `lang()`, `is_lang()`, `lang_fn()`, `lang_name()`, `lang_args()`. In addition, `lang_head()` and `lang_tail()` are soft-deprecated without replacement because these are low level accessors that are rarely needed. * `as_overscope()` is soft-deprecated in favour of `as_data_mask()`. * The node setters were renamed from `mut_node_` prefix to `node_poke_`. This change follows a new naming convention in rlang where mutation is referred to as "poking". * `splice()` is now in questioning stage as it is not needed given the `!!!` operator works in functions taking dots with `dots_list()`. * `lgl_len()`, `int_len()` etc have been soft-deprecated and renamed with `new_` prefix, e.g. `new_logical()` and `new_integer()`. This is for consistency with other non-variadic object constructors. * `ll()` is now an alias to `list2()`. This is consistent with the new `call2()` constructor for calls. `list2()` and `call2()` are versions of `list()` and `call()` that support splicing of lists with `!!!`. `ll()` remains around as a shorthand for users who like its conciseness. * Automatic splicing of lists in vector constructors (e.g. `lgl()`, `chr()`, etc) is now soft-deprecated. Please be explicit with the splicing operator `!!!`. # rlang 0.1.6 * This is a maintenance release in anticipation of a forthcoming change to R's C API (use `MARK_NOT_MUTABLE()` instead of `SET_NAMED()`). * New function `is_reference()` to check whether two objects are one and the same. # rlang 0.1.4 * `eval_tidy()` no longer maps over lists but returns them literally. This behaviour is an overlook from past refactorings and was never documented. # rlang 0.1.2 This hotfix release makes rlang compatible with the R 3.1 branch. # rlang 0.1.1 This release includes two important fixes for tidy evaluation: * Bare formulas are now evaluated in the correct environment in tidyeval functions. * `enquo()` now works properly within compiled functions. Before this release, constants optimised by the bytecode compiler couldn't be enquoted. ## New functions: * The `new_environment()` constructor creates a child of the empty environment and takes an optional named list of data to populate it. Compared to `env()` and `child_env()`, it is meant to create environments as data structures rather than as part of a scope hierarchy. * The `new_call()` constructor creates calls out of a callable object (a function or an expression) and a pairlist of arguments. It is useful to avoid costly internal coercions between lists and pairlists of arguments. ## UI improvements: * `env_child()`'s first argument is now `.parent` instead of `parent`. * `mut_` setters like `mut_attrs()` and environment helpers like `env_bind()` and `env_unbind()` now return their (modified) input invisibly. This follows the tidyverse convention that functions called primarily for their side effects should return their input invisibly. * `is_pairlist()` now returns `TRUE` for `NULL`. We added `is_node()` to test for actual pairlist nodes. In other words, `is_pairlist()` tests for the data structure while `is_node()` tests for the type. ## Bugfixes: * `env()` and `env_child()` can now get arguments whose names start with `.`. Prior to this fix, these arguments were partial-matching on `env_bind()`'s `.env` argument. * The internal `replace_na()` symbol was renamed to avoid a collision with an exported function in tidyverse. This solves an issue occurring in old versions of R prior to 3.3.2 (#133). # rlang 0.1.0 Initial release. rlang/R/0000755000176200001440000000000013242736425011566 5ustar liggesusersrlang/R/utils.R0000644000176200001440000001171313241233650013043 0ustar liggesusers substitute_ <- function(x, env) { if (identical(env, globalenv())) { env <- as.list(env) } call <- substitute(substitute(x, env), list(x = x)) eval_bare(call) } drop_last <- function(x) { x[-length(x)] } drop_first <- function(x) { x[-1] } set_names2 <- function(x, nms = names2(x)) { empty <- nms == "" nms[empty] <- x[empty] names(x) <- nms x } imap <- function(.x, .f, ...) { idx <- names(.x) %||% seq_along(.x) out <- Map(.f, idx, .x, ...) names(out) <- names(.x) out } imap_chr <- function(.x, .f, ...) { as.vector(imap(.x, .f, ...), "character") } map_around <- function(.x, .neighbour = c("right", "left"), .f, ...) { where <- arg_match(.neighbour) n <- length(.x) out <- vector("list", n) if (n == 0) { return(.x) } if (n == 1) { out[[1]] <- .f(.x[[1]], missing_arg(), ...) return(out) } if (n > 1 && where == "right") { neighbours <- .x[seq(2, n)] idx <- seq_len(n - 1) out[idx] <- Map(.f, .x[idx], neighbours, ...) out[[n]] <- .f(.x[[n]], missing_arg(), ...) return(out) } if (n > 1 && where == "left") { neighbours <- .x[seq(1, n - 1)] idx <- seq(2, n) out[idx] <- Map(.f, .x[idx], neighbours, ...) out[[1]] <- .f(.x[[1]], missing_arg(), ...) return(out) } stop("unimplemented") } discard_unnamed <- function(x) { if (is_env(x)) { x } else { discard(x, names2(x) == "") } } captureArgInfo <- function(x) { args <- pairlist(parent.frame()) .Call(rlang_capturearginfo, NULL, NULL, args, environment()) } captureDots <- function() { args <- pairlist(parent.frame()) .Call(rlang_capturedots, NULL, NULL, args, environment()) } meow <- function(..., .trailing = TRUE) { cat(chr_lines(..., .trailing = .trailing)) } chr_lines <- function(..., .trailing = FALSE) { lines <- paste(chr(...), collapse = "\n") if (.trailing) { lines <- paste0(lines, "\n") } lines } red <- function(x) { if (is_installed("crayon")) { crayon::red(x) } else { x } } blue <- function(x) { if (is_installed("crayon")) { crayon::blue(x) } else { x } } green <- function(x) { if (is_installed("crayon")) { crayon::green(x) } else { x } } yellow <- function(x) { if (is_installed("crayon")) { crayon::yellow(x) } else { x } } magenta <- function(x) { if (is_installed("crayon")) { crayon::magenta(x) } else { x } } cyan <- function(x) { if (is_installed("crayon")) { crayon::cyan(x) } else { x } } has_crayon <- function() { is_installed("crayon") && crayon::has_color() } open_red <- function() if (has_crayon()) open_style("red") open_blue <- function() if (has_crayon()) open_style("blue") open_green <- function() if (has_crayon()) open_style("green") open_yellow <- function() if (has_crayon()) open_style("yellow") open_magenta <- function() if (has_crayon()) open_style("magenta") open_cyan <- function() if (has_crayon()) open_style("cyan") close_colour <- function() if (has_crayon()) "\u001b[39m" close_italic <- function() if (has_crayon()) "\u001b[23m" open_yellow_italic <- function() if (has_crayon()) "\u001b[33m\u001b[3m" open_blurred_italic <- function() if (has_crayon()) "\u001b[2m\u001b[3m" close_blurred_italic <- function() if (has_crayon()) "\u001b[23m\u001b[22m" open_style <- function(style) { paste0("\u001b[", codes[[style]][[1]], "m") } close_style <- function(style) { paste0("\u001b[", codes[[style]][[2]], "m") } ansi_regex <- paste0( "(?:(?:\\x{001b}\\[)|\\x{009b})", "(?:(?:[0-9]{1,3})?(?:(?:;[0-9]{0,3})*)?[A-M|f-m])", "|\\x{001b}[A-M]" ) strip_style <- function(x) { gsub(ansi_regex, "", x, perl = TRUE) } codes <- list( reset = c(0L, 0L), bold = c(1L, 22L), blurred = c(2L, 22L), italic = c(3L, 23L), underline = c(4L, 24L), inverse = c(7L, 27L), hidden = c(8L, 28L), strikethrough = c(9L, 29L), black = c(30L, 39L), red = c(31L, 39L), green = c(32L, 39L), yellow = c(33L, 39L), blue = c(34L, 39L), magenta = c(35L, 39L), cyan = c(36L, 39L), white = c(37L, 39L), silver = c(90L, 39L), bgBlack = c(40L, 49L), bgRed = c(41L, 49L), bgGreen = c(42L, 49L), bgYellow = c(43L, 49L), bgBlue = c(44L, 49L), bgMagenta = c(45L, 49L), bgCyan = c(46L, 49L), bgWhite = c(47L, 49L) ) `$.r6lite` <- function(self, arg) { field <- env_get(self, as_string(substitute(arg)), inherit = TRUE) if (is_function(field)) { expr_interp(function(...) { # Unquote the method so it is printable method <- !!field method(self, ...) }) } else { field } } r6lite <- function(...) { structure(new_environment(dots_list(...)), class = "r6lite") } child_r6lite <- function(.parent, ...) { structure(child_env(.parent, ...), class = "r6lite") } inc <- function(x) { x + 1L } dec <- function(x) { x - 1L } rlang/R/cnd.R0000644000176200001440000003144013241304305012442 0ustar liggesusers#' Create a condition object #' #' These constructors make it easy to create subclassed conditions. #' Conditions are objects that power the error system in R. They can #' also be used for passing messages to pre-established handlers. #' #' `cnd()` creates objects inheriting from `condition`. Conditions #' created with `error_cnd()`, `warning_cnd()` and `message_cnd()` #' inherit from `error`, `warning` or `message`. #' #' @param .type The condition subclass. #' @param ... Named data fields stored inside the condition #' object. These dots are evaluated with [explicit #' splicing][tidy-dots]. #' @param .msg A default message to inform the user about the #' condition when it is signalled. #' @seealso [cnd_signal()], [with_handlers()]. #' @export #' @examples #' # Create a condition inheriting from the s3 type "foo": #' cnd <- cnd("foo") #' #' # Signal the condition to potential handlers. This has no effect if no #' # handler is registered to deal with conditions of type "foo": #' cnd_signal(cnd) #' #' # If a relevant handler is on the current evaluation stack, it will be #' # called by cnd_signal(): #' with_handlers(cnd_signal(cnd), foo = exiting(function(c) "caught!")) #' #' # Handlers can be thrown or executed inplace. See with_handlers() #' # documentation for more on this. #' #' #' # Note that merely signalling a condition inheriting of "error" is #' # not sufficient to stop a program: #' cnd_signal(error_cnd("my_error")) #' #' # you need to use stop() to signal a critical condition that should #' # terminate the program if not handled: #' # stop(error_cnd("my_error")) cnd <- function(.type = NULL, ..., .msg = NULL) { .Call(rlang_new_condition, .type, dots_list(...), .msg) } #' @rdname cnd #' @export error_cnd <- function(.type = NULL, ..., .msg = NULL) { cnd(c(.type, "error"), ..., .msg = .msg) } #' @rdname cnd #' @export warning_cnd <- function(.type = NULL, ..., .msg = NULL) { cnd(c(.type, "warning"), ..., .msg = .msg) } #' @rdname cnd #' @export message_cnd <- function(.type = NULL, ..., .msg = NULL) { cnd(c(.type, "message"), ..., .msg = .msg) } #' Is object a condition? #' @param x An object to test. #' @export is_condition <- function(x) { inherits(x, "condition") } #' Signal a condition #' #' Signal a condition to handlers that have been established on the #' stack. Conditions signalled with `cnd_signal()` are assumed to be #' benign. Control flow can resume normally once the conditions has #' been signalled (if no handler jumped somewhere else on the #' evaluation stack). On the other hand, `cnd_abort()` treats the #' condition as critical and will jump out of the distressed call #' frame (see [rst_abort()]), unless a handler can deal with the #' condition. #' #' If `.critical` is `FALSE`, this function has no side effects beyond #' calling handlers. In particular, execution will continue normally #' after signalling the condition (unless a handler jumped somewhere #' else via [rst_jump()] or by being [exiting()]). If `.critical` is #' `TRUE`, the condition is signalled via [base::stop()] and the #' program will terminate if no handler dealt with the condition by #' jumping out of the distressed call frame. #' #' [inplace()] handlers are called in turn when they decline to handle #' the condition by returning normally. However, it is sometimes #' useful for an inplace handler to produce a side effect (signalling #' another condition, displaying a message, logging something, etc), #' prevent the condition from being passed to other handlers, and #' resume execution from the place where the condition was #' signalled. The easiest way to accomplish this is by jumping to a #' restart point (see [with_restarts()]) established by the signalling #' function. If `.mufflable` is `TRUE`, a muffle restart is #' established. This allows inplace handler to muffle a signalled #' condition. See [rst_muffle()] to jump to a muffling restart, and #' the `muffle` argument of [inplace()] for creating a muffling #' handler. #' #' @inheritParams cnd #' @param .cnd Either a condition object (see [cnd()]), or the #' name of a s3 class from which a new condition will be created. #' @param .msg A string to override the condition's default message. #' @param .call Whether to display the call of the frame in which the #' condition is signalled. If `TRUE`, the call is stored in the #' `call` field of the condition object: this field is displayed by #' R when an error is issued. If a number `n`, the call is taken #' from the nth frame on the [call stack][call_stack]. If `NULL`, #' the call is taken from the `.call` field that was supplied to the #' condition constructor (e.g. [cnd()]). In all cases the `.call` #' field is updated with the actual call. #' @param .mufflable Whether to signal the condition with a muffling #' restart. This is useful to let [inplace()] handlers muffle a #' condition. It stops the condition from being passed to other #' handlers when the inplace handler did not jump elsewhere. `TRUE` #' by default for benign conditions, but `FALSE` for critical ones, #' since in those cases execution should probably not be allowed to #' continue normally. #' @seealso [abort()], [warn()] and [inform()] for signalling typical #' R conditions. See [with_handlers()] for establishing condition #' handlers. #' @export #' @examples #' # Creating a condition of type "foo" #' cnd <- cnd("foo") #' #' # If no handler capable of dealing with "foo" is established on the #' # stack, signalling the condition has no effect: #' cnd_signal(cnd) #' #' # To learn more about establishing condition handlers, see #' # documentation for with_handlers(), exiting() and inplace(): #' with_handlers(cnd_signal(cnd), #' foo = inplace(function(c) cat("side effect!\n")) #' ) #' #' #' # By default, cnd_signal() creates a muffling restart which allows #' # inplace handlers to prevent a condition from being passed on to #' # other handlers and to resume execution: #' undesirable_handler <- inplace(function(c) cat("please don't call me\n")) #' muffling_handler <- inplace(function(c) { #' cat("muffling foo...\n") #' rst_muffle(c) #' }) #' #' with_handlers(foo = undesirable_handler, #' with_handlers(foo = muffling_handler, { #' cnd_signal("foo") #' "return value" #' })) #' #' #' # cnd_warn() and cnd_inform() signal a condition and display a #' # warning or message: #' \dontrun{ #' cnd_inform(cnd) #' cnd_warn(cnd) #' } #' #' # You can signal a critical condition with cnd_abort(). Unlike #' # cnd_signal() which has no side effect besides signalling the #' # condition, cnd_abort() makes the program terminate with an error #' # unless a handler can deal with the condition: #' \dontrun{ #' cnd_abort(cnd) #' } #' #' # If you don't specify a .msg or .call, the default message/call #' # (supplied to cnd()) are displayed. Otherwise, the ones #' # supplied to cnd_abort() and cnd_signal() take precedence: #' \dontrun{ #' critical <- cnd("my_error", #' .msg = "default 'my_error' msg", #' .call = quote(default(call)) #' ) #' cnd_abort(critical) #' cnd_abort(critical, .msg = "overridden msg") #' #' fn <- function(...) { #' cnd_abort(critical, .call = TRUE) #' } #' fn(arg = foo(bar)) #' } #' #' # Note that by default a condition signalled with cnd_abort() does #' # not have a muffle restart. That is because in most cases, #' # execution should not continue after signalling a critical #' # condition. cnd_signal <- function(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = TRUE) { cnd <- cnd_update(.cnd, ..., .msg = .msg, .call = cnd_call(.call), .show_call = .call) invisible(.Call(rlang_cnd_signal, cnd, .mufflable)) } #' @rdname cnd_signal #' @export cnd_inform <- function(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = FALSE) { cnd <- as_special_cnd(.cnd, "message") cnd <- cnd_update(cnd, ..., .msg = .msg, .call = cnd_call(.call), .show_call = .call) invisible(.Call(rlang_cnd_inform, cnd, .mufflable)) } #' @rdname cnd_signal #' @export cnd_warn <- function(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = FALSE) { cnd <- as_special_cnd(.cnd, "warning") cnd <- cnd_update(cnd, ..., .msg = .msg, .call = cnd_call(.call), .show_call = .call) invisible(.Call(rlang_cnd_warn, cnd, .mufflable)) } #' @rdname cnd_signal #' @export cnd_abort <- function(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = FALSE) { cnd <- as_special_cnd(.cnd, "error") cnd <- cnd_update(cnd, ..., .msg = .msg, .call = cnd_call(.call), .show_call = .call) invisible(.Call(rlang_cnd_abort, cnd, .mufflable)) } cnd_call <- function(call) { if (is_scalar_logical(call) || is_null(call)) { call <- 1 } else if (!is_scalar_integerish(call)) { stop("`call` must be a scalar boolean or number", call. = FALSE) } caller_frame(call + 1)$expr } cnd_update <- function(.cnd, ..., .msg, .call, .show_call) { if (is_character(.cnd)) { .cnd <- cnd(.cnd, ...) } else { stopifnot(is_condition(.cnd)) } # Override default field if supplied .cnd$message <- .msg %||% .cnd$message %||% "" # The `call` field is displayed by stop() and display is controlled # by user. If NULL, use the call stored in the condition. If TRUE, # use the current call. if (is_null(.show_call)) { .cnd$call <- .cnd$.call } else if (is_true(.show_call) || is_scalar_integerish(.show_call)) { .cnd$call <- .call } else if (is_false(.show_call)) { .cnd$call <- NULL } else { stop("Internal error: unexpected `.show_call`", call. = FALSE) } # Record actual call in `.call` in all cases .cnd$.call <- .call .cnd } as_special_cnd <- function(cnd, type) { if (is_character(cnd) && !type %in% cnd) { return(c(cnd, type)) } if (is_condition(cnd) && !inherits(cnd, type)) { classes <- class(cnd) pos <- match("condition", classes) before <- classes[seq_len(pos - 1)] after <- classes[seq.int(pos, length(classes))] class(cnd) <- chr(before, type, after) } cnd } # Used in C implementation muffle <- function(...) NULL #' Signal an error, warning, or message #' #' These functions are equivalent to base functions [base::stop()], #' [base::warning()] and [base::message()], but the `type` argument #' makes it easy to create subclassed conditions. They also don't #' include call information by default. This saves you from typing #' `call. = FALSE` to make error messages cleaner within package #' functions. #' #' Like `stop()` and [cnd_abort()], `abort()` signals a critical #' condition and interrupts execution by jumping to top level (see #' [rst_abort()]). Only a handler of the relevant type can prevent #' this jump by making another jump to a different target on the stack #' (see [with_handlers()]). #' #' `warn()` and `inform()` both have the side effect of displaying a #' message. These messages will not be displayed if a handler #' transfers control. Transfer can be achieved by establishing an #' exiting handler that transfers control to [with_handlers()]). In #' this case, the current function stops and execution resumes at the #' point where handlers were established. #' #' Since it is often desirable to continue normally after a message or #' warning, both `warn()` and `inform()` (and their base R equivalent) #' establish a muffle restart where handlers can jump to prevent the #' message from being displayed. Execution resumes normally after #' that. See [rst_muffle()] to jump to a muffling restart, and the #' `muffle` argument of [inplace()] for creating a muffling handler. #' #' @param msg A message to display. #' @param type Subclass of the condition to signal. #' @param call Whether to display the call. If a number `n`, the call #' is taken from the nth frame on the [call stack][call_stack]. #' @export abort <- function(msg, type = NULL, call = FALSE) { cnd <- error_cnd(type, .msg = msg, .call = cnd_call(call)) if (!is_false(call)) { cnd$call <- cnd$.call } stop(cnd) } #' @rdname abort #' @export warn <- function(msg, type = NULL, call = FALSE) { cnd <- warning_cnd(type, .msg = msg, .call = cnd_call(call)) if (!is_false(call)) { cnd$call <- cnd$.call } warning(cnd) } #' @rdname abort #' @export inform <- function(msg, type = NULL, call = FALSE) { msg <- paste0(msg, "\n") cnd <- message_cnd(type, .msg = msg, .call = cnd_call(call)) if (!is_false(call)) { cnd$call <- cnd$.call } message(cnd) } #' Catch a condition #' #' This is a small wrapper around `tryCatch()` that captures any #' condition signalled while evaluating its argument. It is useful for #' debugging and unit testing. #' #' @param expr Expression to be evaluated with a catch-all condition #' handler. #' @return A condition if any was signalled, `NULL` otherwise. #' @export #' @examples #' catch_cnd(10) #' catch_cnd(abort("an error")) #' catch_cnd(cnd_signal("my_condition", .msg = "a condition")) catch_cnd <- function(expr) { tryCatch(condition = identity, { force(expr) return(NULL) }) } rlang/R/expr.R0000644000176200001440000002427213241233650012665 0ustar liggesusers#' Is an object an expression? #' #' @description #' #' `is_expression()` tests for expressions, the set of objects that can be #' obtained from parsing R code. An expression can be one of two #' things: either a symbolic object (for which `is_symbolic()` returns #' `TRUE`), or a syntactic literal (testable with #' `is_syntactic_literal()`). Technically, calls can contain any R #' object, not necessarily symbolic objects or syntactic #' literals. However, this only happens in artificial #' situations. Expressions as we define them only contain numbers, #' strings, `NULL`, symbols, and calls: this is the complete set of R #' objects that can be created when R parses source code (e.g. from #' using [parse_expr()]). #' #' Note that we are using the term expression in its colloquial sense #' and not to refer to [expression()] vectors, a data type that wraps #' expressions in a vector and which isn't used much in modern R code. #' #' @details #' #' `is_symbolic()` returns `TRUE` for symbols and calls (objects with #' type `language`). Symbolic objects are replaced by their value #' during evaluation. Literals are the complement of symbolic #' objects. They are their own value and return themselves during #' evaluation. #' #' `is_syntactic_literal()` is a predicate that returns `TRUE` for the #' subset of literals that are created by R when parsing text (see #' [parse_expr()]): numbers, strings and `NULL`. Along with symbols, #' these literals are the terminating nodes in an AST. #' #' Note that in the most general sense, a literal is any R object that #' evaluates to itself and that can be evaluated in the empty #' environment. For instance, `quote(c(1, 2))` is not a literal, it is #' a call. However, the result of evaluating it in [base_env()] is a #' literal(in this case an atomic vector). #' #' Pairlists are also a kind of language objects. However, since they #' are mostly an internal data structure, `is_expression()` returns `FALSE` #' for pairlists. You can use `is_pairlist()` to explicitly check for #' them. Pairlists are the data structure for function arguments. They #' usually do not arise from R code because subsetting a call is a #' type-preserving operation. However, you can obtain the pairlist of #' arguments by taking the CDR of the call object from C code. The #' rlang function [node_cdr()] will do it from R. Another way in #' which pairlist of arguments arise is by extracting the argument #' list of a closure with [base::formals()] or [fn_fmls()]. #' #' @param x An object to test. #' @seealso [is_call()] for a call predicate. #' @export #' @examples #' q1 <- quote(1) #' is_expression(q1) #' is_syntactic_literal(q1) #' #' q2 <- quote(x) #' is_expression(q2) #' is_symbol(q2) #' #' q3 <- quote(x + 1) #' is_expression(q3) #' is_call(q3) #' #' #' # Atomic expressions are the terminating nodes of a call tree: #' # NULL or a scalar atomic vector: #' is_syntactic_literal("string") #' is_syntactic_literal(NULL) #' #' is_syntactic_literal(letters) #' is_syntactic_literal(quote(call())) #' #' # Parsable literals have the property of being self-quoting: #' identical("foo", quote("foo")) #' identical(1L, quote(1L)) #' identical(NULL, quote(NULL)) #' #' # Like any literals, they can be evaluated within the empty #' # environment: #' eval_bare(quote(1L), empty_env()) #' #' # Whereas it would fail for symbolic expressions: #' # eval_bare(quote(c(1L, 2L)), empty_env()) #' #' #' # Pairlists are also language objects representing argument lists. #' # You will usually encounter them with extracted formals: #' fmls <- formals(is_expression) #' typeof(fmls) #' #' # Since they are mostly an internal data structure, is_expression() #' # returns FALSE for pairlists, so you will have to check explicitly #' # for them: #' is_expression(fmls) #' is_pairlist(fmls) is_expression <- function(x) { is_symbolic(x) || is_syntactic_literal(x) } #' @export #' @rdname is_expression is_syntactic_literal <- function(x) { typeof(x) == "NULL" || (length(x) == 1 && typeof(x) %in% parsable_atomic_types) } #' @export #' @rdname is_expression is_symbolic <- function(x) { typeof(x) %in% c("language", "symbol") } #' Turn an expression to a label #' #' `expr_text()` turns the expression into a single string, which #' might be multi-line. `expr_name()` is suitable for formatting #' names. It works best with symbols and scalar types, but also #' accepts calls. `expr_label()` formats the expression nicely for use #' in messages. #' #' @param expr An expression to labellise. #' @export #' @examples #' # To labellise a function argument, first capture it with #' # substitute(): #' fn <- function(x) expr_label(substitute(x)) #' fn(x:y) #' #' # Strings are encoded #' expr_label("a\nb") #' #' # Names and expressions are quoted with `` #' expr_label(quote(x)) #' expr_label(quote(a + b + c)) #' #' # Long expressions are collapsed #' expr_label(quote(foo({ #' 1 + 2 #' print(x) #' }))) expr_label <- function(expr) { if (is.character(expr)) { encodeString(expr, quote = '"') } else if (is.atomic(expr)) { format(expr) } else if (is.name(expr)) { paste0("`", as.character(expr), "`") } else { chr <- deparse_one(expr) paste0("`", chr, "`") } } #' @rdname expr_label #' @export expr_name <- function(expr) { switch_type(expr, symbol = as_string(expr), quosure = , language = { name <- deparse_one(expr) name <- gsub("\n.*$", "...", name) name }, if (is_scalar_atomic(expr)) { # So 1L is translated to "1" and not "1L" as.character(expr) } else if (length(expr) == 1) { name <- expr_text(expr) name <- gsub("\n.*$", "...", name) name } else { abort("`expr` must quote a symbol, scalar, or call") } ) } #' @rdname expr_label #' @export #' @param width Width of each line. #' @param nlines Maximum number of lines to extract. expr_text <- function(expr, width = 60L, nlines = Inf) { str <- deparse(expr, width.cutoff = width) if (length(str) > nlines) { str <- c(str[seq_len(nlines - 1)], "...") } paste0(str, collapse = "\n") } deparse_one <- function(expr) { str <- deparse(expr, 60L) if (length(str) > 1) { if (is_call(expr, function_sym)) { expr[[3]] <- quote(...) str <- deparse(expr, 60L) } else if (is_call(expr, brace_sym)) { str <- "{ ... }" } else if (is_call(expr)) { str <- deparse(call2(expr[[1]], quote(...)), 60L) } str <- paste(str, collapse = "\n") } str } #' Set and get an expression #' #' These helpers are useful to make your function work generically #' with quosures and raw expressions. First call `get_expr()` to #' extract an expression. Once you're done processing the expression, #' call `set_expr()` on the original object to update the expression. #' You can return the result of `set_expr()`, either a formula or an #' expression depending on the input type. Note that `set_expr()` does #' not change its input, it creates a new object. #' #' @param x An expression, closure, or one-sided formula. In addition, #' `set_expr()` accept frames. #' @param value An updated expression. #' @param default A default expression to return when `x` is not an #' expression wrapper. Defaults to `x` itself. #' @return The updated original input for `set_expr()`. A raw #' expression for `get_expr()`. #' @seealso [quo_get_expr()] and [quo_set_expr()] for versions of #' [get_expr()] and [set_expr()] that only work on quosures. #' @export #' @examples #' f <- ~foo(bar) #' e <- quote(foo(bar)) #' frame <- identity(identity(ctxt_frame())) #' #' get_expr(f) #' get_expr(e) #' get_expr(frame) #' #' set_expr(f, quote(baz)) #' set_expr(e, quote(baz)) set_expr <- function(x, value) { if (is_quosure(x)) { x <- quo_set_expr(x, value) } else if (is_formula(x)) { f_rhs(x) <- value } else if (is_closure(x)) { body(x) <- value } else { x <- value } x } #' @rdname set_expr #' @export get_expr <- function(x, default = x) { .Call(rlang_get_expression, x, default) } expr_type_of <- function(x) { if (missing(x)) { return("missing") } type <- typeof(x) if (type %in% c("symbol", "language", "pairlist", "NULL")) { type } else { "literal" } } switch_expr <- function(.x, ...) { switch(expr_type_of(.x), ...) } #' Print an expression #' #' @description #' #' `expr_print()`, powered by `expr_deparse()`, is an alternative #' printer for R expressions with a few improvements over the base R #' printer. #' #' * It colourises [quosures][quotation] according to their environment. #' Quosures from the global environment are printed normally while #' quosures from local environments are printed in unique colour (or #' in italic when all colours are taken). #' #' * It wraps inlined objects in angular brackets. For instance, an #' integer vector unquoted in a function call (e.g. #' `expr(foo(!!(1:3)))`) is printed like this: `foo()` while by default R prints the code to create that vector: #' `foo(1:3)` which is ambiguous. #' #' * It respects the width boundary (from the global option `width`) #' in more cases. #' #' @param x An object or expression to print. #' @param width The width of the deparsed or printed expression. #' Defaults to the global option `width`. #' #' @export #' @examples #' # It supports any object. Non-symbolic objects are always printed #' # within angular brackets: #' expr_print(1:3) #' expr_print(function() NULL) #' #' # Contrast this to how the code to create these objects is printed: #' expr_print(quote(1:3)) #' expr_print(quote(function() NULL)) #' #' # The main cause of non-symbolic objects in expressions is #' # quasiquotation: #' expr_print(expr(foo(!!(1:3)))) #' #' #' # Quosures from the global environment are printed normally: #' expr_print(quo(foo)) #' expr_print(quo(foo(!!quo(bar)))) #' #' # Quosures from local environments are colourised according to #' # their environments (if you have crayon installed): #' local_quo <- local(quo(foo)) #' expr_print(local_quo) #' #' wrapper_quo <- local(quo(bar(!!local_quo, baz))) #' expr_print(wrapper_quo) expr_print <- function(x, width = peek_option("width")) { meow(expr_deparse(x, width = width)) } #' @rdname expr_print #' @export expr_deparse <- function(x, width = peek_option("width")) { deparser <- new_quo_deparser(width = width) quo_deparse(x, deparser) } rlang/R/cnd-restarts.R0000644000176200001440000002235313241305652014320 0ustar liggesusers#' Establish a restart point on the stack #' #' Restart points are named functions that are established with #' `with_restarts()`. Once established, you can interrupt the normal #' execution of R code, jump to the restart, and resume execution from #' there. Each restart is established along with a restart function #' that is executed after the jump and that provides a return value #' from the establishing point (i.e., a return value for #' `with_restarts()`). #' #' Restarts are not the only way of jumping to a previous call frame #' (see [return_from()] or [return_to()]). However, they have the advantage of #' being callable by name once established. #' #' @param .expr An expression to execute with new restarts established #' on the stack. This argument is passed by expression and supports #' [unquoting][quasiquotation]. It is evaluated in a context where #' restarts are established. #' @param ... Named restart functions. The name is taken as the #' restart name and the function is executed after the jump. These #' dots support [tidy dots][tidy-dots] features. #' @seealso [return_from()] and [return_to()] for a more flexible way #' of performing a non-local jump to an arbitrary call frame. #' @export #' @examples #' # Restarts are not the only way to jump to a previous frame, but #' # they have the advantage of being callable by name: #' fn <- function() with_restarts(g(), my_restart = function() "returned") #' g <- function() h() #' h <- function() { rst_jump("my_restart"); "not returned" } #' fn() #' #' # Whereas a non-local return requires to manually pass the calling #' # frame to the return function: #' fn <- function() g(get_env()) #' g <- function(env) h(env) #' h <- function(env) { return_from(env, "returned"); "not returned" } #' fn() #' #' #' # rst_maybe_jump() checks that a restart exists before trying to jump: #' fn <- function() { #' g() #' cat("will this be called?\n") #' } #' g <- function() { #' rst_maybe_jump("my_restart") #' cat("will this be called?\n") #' } #' #' # Here no restart are on the stack: #' fn() #' #' # If a restart point called `my_restart` was established on the #' # stack before calling fn(), the control flow will jump there: #' rst <- function() { #' cat("restarting...\n") #' "return value" #' } #' with_restarts(fn(), my_restart = rst) #' #' #' # Restarts are particularly useful to provide alternative default #' # values when the normal output cannot be computed: #' #' fn <- function(valid_input) { #' if (valid_input) { #' return("normal value") #' } #' #' # We decide to return the empty string "" as default value. An #' # altenative strategy would be to signal an error. In any case, #' # we want to provide a way for the caller to get a different #' # output. For this purpose, we provide two restart functions that #' # returns alternative defaults: #' restarts <- list( #' rst_empty_chr = function() character(0), #' rst_null = function() NULL #' ) #' #' with_restarts(splice(restarts), .expr = { #' #' # Signal a typed condition to let the caller know that we are #' # about to return an empty string as default value: #' cnd_signal("default_empty_string") #' #' # If no jump to with_restarts, return default value: #' "" #' }) #' } #' #' # Normal value for valid input: #' fn(TRUE) #' #' # Default value for bad input: #' fn(FALSE) #' #' # Change the default value if you need an empty character vector by #' # defining an inplace handler that jumps to the restart. It has to #' # be inplace because exiting handlers jump to the place where they #' # are established before being executed, and the restart is not #' # defined anymore at that point: #' rst_handler <- inplace(function(c) rst_jump("rst_empty_chr")) #' with_handlers(fn(FALSE), default_empty_string = rst_handler) #' #' # You can use restarting() to create restarting handlers easily: #' with_handlers(fn(FALSE), default_empty_string = restarting("rst_null")) with_restarts <- function(.expr, ...) { quo <- quo(withRestarts(expr = !! enquo(.expr), !!! dots_list(...))) eval_tidy(quo) } #' Restarts utilities #' #' Restarts are named jumping points established by [with_restarts()]. #' `rst_list()` returns the names of all restarts currently #' established. `rst_exists()` checks if a given restart is #' established. `rst_jump()` stops execution of the current function #' and jumps to a restart point. If the restart does not exist, an #' error is thrown. `rst_maybe_jump()` first checks that a restart #' exists before jumping. #' #' @param .restart The name of a restart. #' @param ... Arguments passed on to the restart function. These #' dots support [tidy dots][tidy-dots] features. #' @seealso [with_restarts()], [rst_muffle()]. #' @export rst_list <- function() { computeRestarts() } #' @rdname rst_list #' @export rst_exists <- function(.restart) { !is.null(findRestart(.restart)) } #' @rdname rst_list #' @export rst_jump <- function(.restart, ...) { args <- c(list(r = .restart), dots_list(...)) do.call("invokeRestart", args) } #' @rdname rst_list #' @export rst_maybe_jump <- function(.restart, ...) { if (rst_exists(.restart)) { args <- c(list(r = .restart), dots_list(...)) do.call("invokeRestart", args) } } #' Jump to the abort restart #' #' The abort restart is the only restart that is established at top #' level. It is used by R as a top-level target, most notably when an #' error is issued (see [abort()]) that no handler is able #' to deal with (see [with_handlers()]). #' #' @seealso [rst_jump()], [abort()] and [cnd_abort()]. #' @export #' @examples #' # The `abort` restart is a bit special in that it is always #' # registered in a R session. You will always find it on the restart #' # stack because it is established at top level: #' rst_list() #' #' # You can use the `above` restart to jump to top level without #' # signalling an error: #' \dontrun{ #' fn <- function() { #' cat("aborting...\n") #' rst_abort() #' cat("This is never called\n") #' } #' { #' fn() #' cat("This is never called\n") #' } #' } #' #' # The `above` restart is the target that R uses to jump to top #' # level when critical errors are signalled: #' \dontrun{ #' { #' abort("error") #' cat("This is never called\n") #' } #' } #' #' # If another `abort` restart is specified, errors are signalled as #' # usual but then control flow resumes with from the new restart: #' \dontrun{ #' out <- NULL #' { #' out <- with_restarts(abort("error"), abort = function() "restart!") #' cat("This is called\n") #' } #' cat("`out` has now become:", out, "\n") #' } rst_abort <- function() { rst_jump("abort") } #' Jump to a muffling restart #' #' Muffle restarts are established at the same location as where a #' condition is signalled. They are useful for two non-exclusive #' purposes: muffling signalling functions and muffling conditions. In #' the first case, `rst_muffle()` prevents any further side effects of #' a signalling function (a warning or message from being displayed, #' an aborting jump to top level, etc). In the second case, the #' muffling jump prevents a condition from being passed on to other #' handlers. In both cases, execution resumes normally from the point #' where the condition was signalled. #' #' @param c A condition to muffle. #' @seealso The `muffle` argument of [inplace()], and the `mufflable` #' argument of [cnd_signal()]. #' @export #' @examples #' side_effect <- function() cat("side effect!\n") #' handler <- inplace(function(c) side_effect()) #' #' # A muffling handler is an inplace handler that jumps to a muffle #' # restart: #' muffling_handler <- inplace(function(c) { #' side_effect() #' rst_muffle(c) #' }) #' #' # You can also create a muffling handler simply by setting #' # muffle = TRUE: #' muffling_handler <- inplace(function(c) side_effect(), muffle = TRUE) #' #' # You can then muffle the signalling function: #' fn <- function(signal, msg) { #' signal(msg) #' "normal return value" #' } #' with_handlers(fn(message, "some message"), message = handler) #' with_handlers(fn(message, "some message"), message = muffling_handler) #' with_handlers(fn(warning, "some warning"), warning = muffling_handler) #' #' # Note that exiting handlers are thrown to the establishing point #' # before being executed. At that point, the restart (established #' # within the signalling function) does not exist anymore: #' \dontrun{ #' with_handlers(fn(warning, "some warning"), #' warning = exiting(function(c) rst_muffle(c))) #' } #' #' #' # Another use case for muffle restarts is to muffle conditions #' # themselves. That is, to prevent other condition handlers from #' # being called: #' undesirable_handler <- inplace(function(c) cat("please don't call me\n")) #' #' with_handlers(foo = undesirable_handler, #' with_handlers(foo = muffling_handler, { #' cnd_signal("foo", mufflable = TRUE) #' "return value" #' })) #' #' # See the `mufflable` argument of cnd_signal() for more on this point rst_muffle <- function(c) { UseMethod("rst_muffle") } #' @export rst_muffle.default <- function(c) { abort("No muffle restart defined for this condition", "control") } #' @export rst_muffle.simpleMessage <- function(c) { rst_jump("muffleMessage") } #' @export rst_muffle.simpleWarning <- function(c) { rst_jump("muffleWarning") } #' @export rst_muffle.mufflable <- function(c) { rst_jump("muffle") } rlang/R/operators.R0000644000176200001440000000601313241233650013716 0ustar liggesusers#' Default value for `NULL` #' #' This infix function makes it easy to replace `NULL`s with a default #' value. It's inspired by the way that Ruby's or operation (`||`) #' works. #' #' @param x,y If `x` is NULL, will return `y`; otherwise returns `x`. #' @export #' @name op-null-default #' @examples #' 1 %||% 2 #' NULL %||% 2 `%||%` <- function(x, y) { if (is_null(x)) y else x } #' Replace missing values #' #' This infix function is similar to \code{\%||\%} but is vectorised #' and provides a default value for missing elements. It is faster #' than using [base::ifelse()] and does not perform type conversions. #' #' @param x,y `y` for elements of `x` that are NA; otherwise, `x`. #' @export #' @name op-na-default #' @seealso [op-null-default] #' @examples #' c("a", "b", NA, "c") %|% "default" `%|%` <- function(x, y) { stopifnot(is_atomic(x) && is_scalar_atomic(y)) stopifnot(typeof(x) == typeof(y)) .Call(rlang_replace_na, x, y) } #' Infix attribute accessor #' #' @param x Object #' @param name Attribute name #' @export #' @name op-get-attr #' @examples #' factor(1:3) %@% "levels" #' mtcars %@% "class" `%@%` <- function(x, name) { attr(x, name, exact = TRUE) } #' Definition operator #' #' @description #' #' The definition operator is typically used in DSL packages like #' `ggvis` and `data.table`. It is also used in the tidyverse as a way #' of unquoting names (see [quasiquotation]). #' #' * `is_definition()` returns `TRUE` for calls to `:=`. #' #' * `is_formulaish()` returns `TRUE` for both formulas and #' colon-equals operators. #' #' #' @details #' #' The recommended way to use it is to capture arguments as #' expressions or quosures. You can then give a special function #' definition for the `:=` symbol in an overscope. Note that if you #' capture dots with [exprs()] or [quos()], you need to disable #' interpretation of `:=` by setting `.unquote_names` to `FALSE`. #' #' From rlang and data.table perspectives, this operator is not meant #' to be evaluated directly at top-level which is why the exported #' definitions issue an error. #' #' #' @section Life cycle: #' #' These functions are experimental. #' #' @name op-definition #' @param x An object to test. #' @keywords internal #' @export #' @examples #' #' # A predicate is provided to distinguish formulas from the #' # colon-equals operator: #' is_definition(quote(a := b)) #' is_definition(a ~ b) #' #' #' # is_formulaish() tests for both definitions and formulas: #' is_formulaish(a ~ b) #' is_formulaish(quote(a := b)) is_definition <- function(x) { is_formulaish(x) && identical(node_car(x), colon_equals_sym) } #' @rdname op-definition #' @export #' @param lhs,rhs Expressions for the LHS and RHS of the definition. #' @param env The evaluation environment bundled with the definition. new_definition <- function(lhs, rhs, env = caller_env()) { def <- new_formula(lhs, rhs, env) node_poke_car(def, colon_equals_sym) def } #' @rdname op-definition #' @export is_formulaish <- function(x, scoped = NULL, lhs = NULL) { .Call(rlang_is_formulaish, x, scoped, lhs) } rlang/R/quotation.R0000644000176200001440000002762713241304414013736 0ustar liggesusers#' Quotation #' #' @description #' #' Quotation is a mechanism by which an expression supplied as #' argument is captured by a function. Instead of seeing the value of #' the argument, the function sees the recipe (the R code) to make #' that value. This is possible because R [expressions][is_expr] are #' representable as regular objects in R: #' #' * Calls represent the action of calling a function to #' compute a new value. Evaluating a call causes that value to be #' computed. Calls typically involve symbols to reference R objects. #' #' * Symbols represent the name that is given to an object in a #' particular context (an [environment][env]). #' #' We call objects containing calls and symbols [expressions][is_expr]. #' There are two ways to create R expressions. First you can **build** #' calls and symbols from parts and pieces (see [sym()], [syms()] and #' [call2()]). The other way is by *quotation* or *quasiquotation*, #' i.e. by intercepting an expression instead of evaluating it. #' #' #' @section User expressions versus your expressions: #' #' There are two points of view when it comes to capturing an #' expression: #' #' * You can capture the expressions supplied by _the user_ of your #' function. This is the purpose of `ensym()`, `enexpr()` and #' `enquo()` and their plural variants. These functions take an #' argument name and capture the expression that was supplied to #' that argument. #' #' * You can capture the expressions that _you_ supply. To this end #' use `expr()` and `quo()` and their plural variants `exprs()` and #' `quos()`. #' #' #' @section Capture raw expressions: #' #' * `enexpr()` and `expr()` capture a single raw expression. #' #' * `enexprs()` and `exprs()` capture a list of raw expressions #' including expressions contained in `...`. #' #' * `ensym()` and `ensyms()` are variants of `enexpr()` and #' `enexprs()` that check the captured expression is either a string #' (which they convert to symbol) or a symbol. If anything else #' is supplied they throw an error. #' #' In terms of base functions, `enexpr(arg)` corresponds to #' `base::substitute(arg)` (though that function has complex #' semantics) and `expr()` is like [quote()] (and [bquote()] if we #' consider unquotation syntax). The plural variant `exprs()` is #' equivalent to [base::alist()]. Finally there is no function in base #' R that is equivalent to `enexprs()` but you can reproduce its #' behaviour with `eval(substitute(alist(...)))`. #' #' #' @section Capture expressions in quosures: #' #' `quo()` and `enquo()` are similar to their `expr` counterparts but #' capture both the expression and its environment in an object called #' a quosure. This wrapper contains a reference to the original #' environment in which that expression was captured. Keeping track of #' the environments of expressions is important because this is where #' functions and objects mentioned in the expression are defined. #' #' Quosures are objects that can be evaluated with [eval_tidy()] just #' like symbols or function calls. Since they always evaluate in their #' original environment, quosures can be seen as a vehicle that allow #' expressions to travel from function to function but that beam back #' instantly to their original environment upon evaluation. #' #' See the [quosure] help topic about tools to work with quosures. #' #' #' @section Quasiquotation: #' #' All quotation functions in rlang have support for [unquoting #' operators][quasiquotation]. The combination of quotation and #' unquotation is called *quasiquotation*. #' #' Unquotation provides a way to refer to variables during quotation. #' Variables are problematic when quoting because a captured #' expression is essentially a constant, just like a string is a #' constant. For instance in all the following cases `apple` is a #' constant: `~apple`, `"apple"` and `expr(apple)`. Unquoting allows #' you to introduce a part of variability within a captured #' expression. #' #' * In the case of `enexpr()` and `enquo()`, unquoting provides an #' escape hatch to the users of your function that allows them to #' manipulate the expression that you capture. #' #' * In the case of `expr()` and `quo()`, quasiquotation lets you #' build a complex expressions where some parts are constant (the #' parts that are captured) and some parts are variable (the parts #' that are unquoted). #' #' See the [quasiquotation] help topic for more about this as well as #' [the chapter in Advanced R](https://adv-r.hadley.nz/quasiquotation.html). #' #' #' @section Life cycle: #' #' All the quotation functions mentioned here are stable. #' #' #' @inheritParams tidy-dots #' @param expr An expression. #' @param arg A symbol representing an argument. The expression #' supplied to that argument will be captured instead of being #' evaluated. #' @param ... For `enexprs()`, `ensyms()` and `enquos()`, names of #' arguments to capture without evaluation (including `...`). For #' `exprs()` and `quos()`, the expressions to capture unevaluated #' (including expressions contained in `...`). #' @param .named Whether to ensure all dots are named. Unnamed #' elements are processed with [expr_text()] to figure out a default #' name. If an integer, it is passed to the `width` argument of #' `expr_text()`, if `TRUE`, the default width is used. See #' [exprs_auto_name()]. #' @param .unquote_names Whether to treat `:=` as `=`. Unlike `=`, the #' `:=` syntax supports `!!` unquoting on the LHS. #' @name quotation #' @examples #' # expr() and exprs() capture expressions that you supply: #' expr(symbol) #' exprs(several, such, symbols) #' #' # enexpr() and enexprs() capture expressions that your user supplied: #' expr_inputs <- function(arg, ...) { #' user_exprs <- enexprs(arg, ...) #' user_exprs #' } #' expr_inputs(hello) #' expr_inputs(hello, bonjour, ciao) #' #' # ensym() and ensyms() provide additional type checking to ensure #' # the user calling your function has supplied bare object names: #' sym_inputs <- function(...) { #' user_symbols <- ensyms(...) #' user_symbols #' } #' sym_inputs(hello, "bonjour") #' ## sym_inputs(say(hello)) # Error: Must supply symbols or strings #' expr_inputs(say(hello)) #' #' #' # All these quoting functions have quasiquotation support. This #' # means that you can unquote (evaluate and inline) part of the #' # captured expression: #' what <- sym("bonjour") #' expr(say(what)) #' expr(say(!!what)) #' #' # This also applies to the expressions supplied the user. This is #' # like an escape hatch that allows control over the captured #' # expression: #' expr_inputs(say(!!what), !!what) #' #' #' # Finally, you can capture expressions as quosures. A quosure is an #' # object that contains both the expression and its environment: #' quo <- quo(letters) #' quo #' #' get_expr(quo) #' get_env(quo) #' #' # Quosures can be evaluated with eval_tidy(): #' eval_tidy(quo) #' #' # They have the nice property that you can pass them around from #' # context to context (that is, from function to function) and they #' # still evaluate in their original environment: #' multiply_expr_by_10 <- function(expr) { #' # We capture the user expression and its environment: #' expr <- enquo(expr) #' #' # Then create an object that only exists in this function: #' local_ten <- 10 #' #' # Now let's create a multiplication expression that (a) inlines #' # the user expression as LHS (still wrapped in its quosure) and #' # (b) refers to the local object in the RHS: #' quo(!!expr * local_ten) #' } #' quo <- multiply_expr_by_10(2 + 3) #' #' # The local parts of the quosure are printed in colour if your #' # terminal is capable of displaying colours: #' quo #' #' # All the quosures in the expression evaluate in their original #' # context. The local objects are looked up properly and we get the #' # expected result: #' eval_tidy(quo) NULL #' @rdname quotation #' @export expr <- function(expr) { enexpr(expr) } #' @rdname quotation #' @export enexpr <- function(arg) { .Call(rlang_enexpr, substitute(arg), parent.frame()) } #' @rdname quotation #' @export exprs <- function(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) { .Call(rlang_exprs_interp, environment(), .named, .ignore_empty, .unquote_names) } #' @rdname quotation #' @export enexprs <- function(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) { endots( environment(), parent.frame(), rlang_enexpr, rlang_exprs_interp, .named, .ignore_empty, .unquote_names ) } #' @rdname quotation #' @export ensym <- function(arg) { .Call(rlang_ensym, substitute(arg), parent.frame()) } #' @rdname quotation #' @export ensyms <- function(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) { exprs <- endots( environment(), parent.frame(), rlang_enexpr, rlang_exprs_interp, .named, .ignore_empty, .unquote_names ) if (!every(exprs, function(x) is_symbol(x) || is_string(x))) { abort("Must supply symbols or strings as argument") } map(exprs, sym) } #' @rdname quotation #' @export quo <- function(expr) { enquo(expr) } #' @rdname quotation #' @export enquo <- function(arg) { .Call(rlang_enquo, substitute(arg), parent.frame()) } #' @rdname quotation #' @export quos <- function(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) { .Call(rlang_quos_interp, environment(), .named, .ignore_empty, .unquote_names) } #' @rdname quotation #' @export enquos <- function(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) { quos <- endots( environment(), parent.frame(), rlang_enquo, rlang_quos_interp, .named, .ignore_empty, .unquote_names ) structure(quos, class = "quosures") } endots <- function(frame, env, capture_arg, capture_dots, .named, .ignore_empty, .unquote_names) { sys_call <- eval_bare(quote(sys.call()), frame) syms <- as.list(node_cdr(sys_call)) if (!is_null(names(syms))) { is_arg <- names(syms) %in% c(".named", ".ignore_empty", ".unquote_names") syms <- syms[!is_arg] } # Avoid note about registration problems dot_call <- .Call splice_dots <- FALSE dots <- map(syms, function(sym) { if (!is_symbol(sym)) { abort("Inputs to capture must be argument names") } if (identical(sym, dots_sym)) { splice_dots <<- TRUE splice(dot_call(capture_dots, env, .named, .ignore_empty, .unquote_names)) } else { dot_call(capture_arg, sym, env) } }) if (splice_dots) { dots <- flatten_if(dots, is_spliced) } if (.named) { dots <- quos_auto_name(dots) } names(dots) <- names2(dots) dots } #' Ensure that list of expressions are all named #' #' This gives default names to unnamed elements of a list of #' expressions (or expression wrappers such as formulas or #' quosures). `exprs_auto_name()` deparses the expressions with #' [expr_text()] by default. `quos_auto_name()` deparses with #' [quo_text()]. #' #' @param exprs A list of expressions. #' @param width Maximum width of names. #' @param printer A function that takes an expression and converts it #' to a string. This function must take an expression as first #' argument and `width` as second argument. #' @export exprs_auto_name <- function(exprs, width = 60L, printer = expr_text) { have_name <- have_name(exprs) if (any(!have_name)) { nms <- map_chr(exprs[!have_name], printer, width = width) names(exprs)[!have_name] <- nms } exprs } #' @rdname exprs_auto_name #' @param quos A list of quosures. #' @export quos_auto_name <- function(quos, width = 60L) { exprs_auto_name(quos, width = width, printer = quo_text) } rlang/R/dots.R0000644000176200001440000002055213241305652012657 0ustar liggesusers#' Collect dots tidily #' #' @description #' #' `list2()` is equivalent to `list(...)` but provides tidy #' dots semantics: #' #' - You can splice other lists with the #' [unquote-splice][quasiquotation] `!!!` operator. #' #' - You can unquote names by using the [unquote][quasiquotation] #' operator `!!` on the left-hand side of `:=`. #' #' We call quasiquotation support in dots **tidy dots** semantics and #' functions taking dots with `list2()` tidy dots functions. #' Quasiquotation is an alternative to `do.call()` idioms and gives #' the users of your functions an uniform syntax to supply a variable #' number of arguments or a variable name. #' #' `dots_list()` is a lower-level version of `list2()` that offers #' additional parameters for dots capture. #' #' #' @details #' #' Note that while all tidy eval [quoting functions][quotation] have #' tidy dots semantics, not all tidy dots functions are quoting #' functions. `list2()` is for standard functions, not quoting #' functions. #' #' #' @section Life cycle: #' #' One difference of `dots_list()` with `list2()` is that it always #' allocates a vector of names even if no names were supplied. In this #' case, the names are all empty `""`. This is for consistency with #' [enquos()] and [enexprs()] but can be quite costly when long lists #' are spliced in the results. For this reason we plan to parameterise #' this behaviour with a `.named` argument and possibly change the #' default. `list2()` does not have this issue. #' #' #' @param ... Arguments with explicit (`dots_list()`) or list #' (`dots_splice()`) splicing semantics. The contents of spliced #' arguments are embedded in the returned list. #' @param .ignore_empty Whether to ignore empty arguments. Can be one #' of `"trailing"`, `"none"`, `"all"`. If `"trailing"`, only the #' last argument is ignored if it is empty. #' @return A list of arguments. This list is always named: unnamed #' arguments are named with the empty string `""`. #' #' @seealso [exprs()] for extracting dots without evaluation. #' @name tidy-dots #' @rdname tidy-dots #' @export #' @examples #' # Let's create a function that takes a variable number of arguments: #' numeric <- function(...) { #' dots <- list2(...) #' num <- as.numeric(dots) #' set_names(num, names(dots)) #' } #' numeric(1, 2, 3) #' #' # The main difference with list(...) is that list2(...) enables #' # the `!!!` syntax to splice lists: #' x <- list(2, 3) #' numeric(1, !!! x, 4) #' #' # As well as unquoting of names: #' nm <- "yup!" #' numeric(!!nm := 1) #' #' #' # One useful application of splicing is to work around exact and #' # partial matching of arguments. Let's create a function taking #' # named arguments and dots: #' fn <- function(data, ...) { #' list2(...) #' } #' #' # You normally cannot pass an argument named `data` through the dots #' # as it will match `fn`'s `data` argument. The splicing syntax #' # provides a workaround: #' fn("wrong!", data = letters) # exact matching of `data` #' fn("wrong!", dat = letters) # partial matching of `data` #' fn(some_data, !!! list(data = letters)) # no matching dots_list <- function(..., .ignore_empty = c("trailing", "none", "all")) { dots <- .Call(rlang_dots_list, environment(), FALSE, .ignore_empty, TRUE) names(dots) <- names2(dots) dots } #' Splice lists #' #' - `splice` marks an object to be spliced. It is equivalent to using #' `!!!` in a function with [tidy dots semantics][tidy-dots]. #' #' - `dots_splice()` is like [dots_list()] but automatically splices #' list inputs. #' #' #' @section Standard splicing versus quoting splicing: #' #' The `!!!` operator works differently in _standard_ functions taking #' dots with `dots_list()` than in _quoting_ functions taking dots #' with [enexprs()] or [enquos()]. #' #' * In quoting functions `!!!` disaggregates its argument (let's call #' it `x`) into as many objects as there are elements in #' `x`. E.g. `quo(foo(!!! c(1, 2)))` is completely equivalent to #' `quo(foo(1, 2))`. The creation of those separate objects has an #' overhead but is typically not important when manipulating calls #' because function calls typically take a small number of #' arguments. #' #' * In standard functions, disaggregating the spliced collection #' would have a negative performance impact in cases where #' `dots_list()` is used to build up data structures from user #' inputs. To avoid this spliced inputs are marked with [splice()] #' and the final list is built with (the equivalent of) #' `flatten_if(dots, is_spliced)`. #' #' Most of the time you should not care about the difference. However #' if you use a standard function taking tidy dots within a quoting #' function, the `!!!` operator will disaggregate its argument because #' the behaviour of the quasiquoting function has priority. You might #' then observe some performance cost in edge cases. Here is one #' example where this would happen: #' #' ``` #' purrr::rerun(10, dplyr::bind_rows(!!! x)) #' ``` #' #' `purrr::rerun()` is a quoting function and `dplyr::bind_rows()` is #' a standard function. Because `bind_rows()` is called _inside_ #' `rerun()`, the list `x` will be disaggregated into a pairlist of #' arguments. To avoid this you can use `splice()` instead: #' #' ``` #' purrr::rerun(10, dplyr::bind_rows(splice(x))) #' ``` #' #' #' @section Life cycle: #' #' * `dots_splice()` is in **questioning** stage. It is part of our #' experiments with dots semantics. Compared to `dots_list()`, #' `dots_splice()` automatically splices lists. We now lean towards #' adopting a single type of dots semantics (those of `dots_list()`) #' where splicing is explicit. #' #' * `splice()` is in questioning stage. It is not clear whether it is #' really needed as there are other ways to avoid the performance #' issue discussed in the section above. #' #' #' @param x A list to splice. #' #' @keywords internal #' @export splice <- function(x) { if (!is_list(x)) { abort("Only lists can be spliced") } structure(x, class = "spliced") } #' @rdname splice #' @export is_spliced <- function(x) { inherits(x, "spliced") } #' @rdname splice #' @export is_spliced_bare <- function(x) { is_bare_list(x) || is_spliced(x) } #' @rdname splice #' @inheritParams tidy-dots #' @export dots_splice <- function(..., .ignore_empty = c("trailing", "none", "all")) { dots <- .Call(rlang_dots_flat_list, environment(), FALSE, .ignore_empty, TRUE) names(dots) <- names2(dots) dots } #' Evaluate dots with preliminary splicing #' #' This is a tool for advanced users. It captures dots, processes #' unquoting and splicing operators, and evaluates them. Unlike #' [dots_list()], it does not flatten spliced objects, instead they #' are attributed a `spliced` class (see [splice()]). You can process #' spliced objects manually, perhaps with a custom predicate (see #' [flatten_if()]). #' #' @inheritParams tidy-dots #' @param ... Arguments to evaluate and process splicing operators. #' @export #' @examples #' dots <- dots_values(!!! list(1, 2), 3) #' dots #' #' # Flatten the objects marked as spliced: #' flatten_if(dots, is_spliced) dots_values <- function(..., .ignore_empty = c("trailing", "none", "all")) { .Call(rlang_dots_values, environment(), FALSE, .ignore_empty, TRUE) } #' Capture definition objects #' #' @section Life cycle: #' #' `dots_definitions()` is experimental. Expect API changes. #' #' @inheritParams quotation #' #' @keywords internal #' @export dots_definitions <- function(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all")) { dots <- .Call(rlang_quos_interp, environment(), .named, .ignore_empty, FALSE) is_def <- map_lgl(dots, function(dot) is_definition(quo_get_expr(dot))) defs <- map(dots[is_def], as_definition) list(dots = dots[!is_def], defs = defs) } as_definition <- function(def) { # The definition comes wrapped in a quosure env <- quo_get_env(def) def <- quo_get_expr(def) list( lhs = new_quosure(f_lhs(def), env), rhs = new_quosure(f_rhs(def), env) ) } dots_node <- function(...) { node_cdr(sys.call()) } #' How many arguments are currently forwarded in dots? #' #' This returns the number of arguments currently forwarded in `...` #' as an integer. #' #' @param ... Forwarded arguments. #' @export #' @examples #' fn <- function(...) dots_n(..., baz) #' fn(foo, bar) dots_n <- function(...) { nargs() } rlang/R/eval.R0000644000176200001440000002206013242711364012633 0ustar liggesusers#' Evaluate an expression in an environment #' #' `eval_bare()` is a lower-level version of function [base::eval()]. #' Technically, it is a simple wrapper around the C function #' `Rf_eval()`. You generally don't need to use `eval_bare()` instead #' of `eval()`. Its main advantage is that it handles stack-sensitive #' (calls such as `return()`, `on.exit()` or `parent.frame()`) more #' consistently when you pass an enviroment of a frame on the call #' stack. #' #' These semantics are possible because `eval_bare()` creates only one #' frame on the call stack whereas `eval()` creates two frames, the #' second of which has the user-supplied environment as frame #' environment. When you supply an existing frame environment to #' `base::eval()` there will be two frames on the stack with the same #' frame environment. Stack-sensitive functions only detect the #' topmost of these frames. We call these evaluation semantics #' "stack inconsistent". #' #' Evaluating expressions in the actual frame environment has useful #' practical implications for `eval_bare()`: #' #' * `return()` calls are evaluated in frame environments that might #' be burried deep in the call stack. This causes a long return that #' unwinds multiple frames (triggering the `on.exit()` event for #' each frame). By contrast `eval()` only returns from the `eval()` #' call, one level up. #' #' * `on.exit()`, `parent.frame()`, `sys.call()`, and generally all #' the stack inspection functions `sys.xxx()` are evaluated in the #' correct frame environment. This is similar to how this type of #' calls can be evaluated deep in the call stack because of lazy #' evaluation, when you force an argument that has been passed #' around several times. #' #' The flip side of the semantics of `eval_bare()` is that it can't #' evaluate `break` or `next` expressions even if called within a #' loop. #' #' #' @section Life cycle: #' #' `eval_bare()` is stable. #' #' @param expr An expression to evaluate. #' @param env The environment in which to evaluate the expression. #' #' @seealso [eval_tidy()] for evaluation with data mask and quosure #' support. #' @export #' @examples #' # eval_bare() works just like base::eval() but you have to create #' # the evaluation environment yourself: #' eval_bare(quote(foo), env(foo = "bar")) #' #' # eval() has different evaluation semantics than eval_bare(). It #' # can return from the supplied environment even if its an #' # environment that is not on the call stack (i.e. because you've #' # created it yourself). The following would trigger an error with #' # eval_bare(): #' ret <- quote(return("foo")) #' eval(ret, env()) #' # eval_bare(ret, env()) # "no function to return from" error #' #' # Another feature of eval() is that you can control surround loops: #' bail <- quote(break) #' while (TRUE) { #' eval(bail) #' # eval_bare(bail) # "no loop for break/next" error #' } #' #' # To explore the consequences of stack inconsistent semantics, let's #' # create a function that evaluates `parent.frame()` deep in the call #' # stack, in an environment corresponding to a frame in the middle of #' # the stack. For consistency we R's lazy evaluation semantics, we'd #' # expect to get the caller of that frame as result: #' fn <- function(eval_fn) { #' list( #' returned_env = middle(eval_fn), #' actual_env = get_env() #' ) #' } #' middle <- function(eval_fn) { #' deep(eval_fn, get_env()) #' } #' deep <- function(eval_fn, eval_env) { #' expr <- quote(parent.frame()) #' eval_fn(expr, eval_env) #' } #' #' # With eval_bare(), we do get the expected environment: #' fn(rlang::eval_bare) #' #' # But that's not the case with base::eval(): #' fn(base::eval) #' #' # Another difference of eval_bare() compared to base::eval() is #' # that it does not insert parasite frames in the evaluation stack: #' get_stack <- quote(identity(ctxt_stack())) #' eval_bare(get_stack) #' eval(get_stack) eval_bare <- function(expr, env = parent.frame()) { .Call(rlang_eval, expr, env) } #' Evaluate an expression within a given environment #' #' These functions evaluate `expr` within a given environment (`env` #' for `with_env()`, or the child of the current environment for #' `locally`). They rely on [eval_bare()] which features a lighter #' evaluation mechanism than base R [base::eval()], and which also has #' some subtle implications when evaluting stack sensitive functions #' (see help for [eval_bare()]). #' #' `locally()` is equivalent to the base function #' [base::local()] but it produces a much cleaner #' evaluation stack, and has stack-consistent semantics. It is thus #' more suited for experimenting with the R language. #' #' #' @section Life cycle: #' #' These functions are experimental. Expect API changes. #' #' #' @inheritParams eval_bare #' @param env An environment within which to evaluate `expr`. Can be #' an object with an [get_env()] method. #' @export #' @examples #' # with_env() is handy to create formulas with a given environment: #' env <- child_env("rlang") #' f <- with_env(env, ~new_formula()) #' identical(f_env(f), env) #' #' # Or functions with a given enclosure: #' fn <- with_env(env, function() NULL) #' identical(get_env(fn), env) #' #' #' # Unlike eval() it doesn't create duplicates on the evaluation #' # stack. You can thus use it e.g. to create non-local returns: #' fn <- function() { #' g(get_env()) #' "normal return" #' } #' g <- function(env) { #' with_env(env, return("early return")) #' } #' fn() #' #' #' # Since env is passed to as_environment(), it can be any object with an #' # as_environment() method. For strings, the pkg_env() is returned: #' with_env("base", ~mtcars) #' #' # This can be handy to put dictionaries in scope: #' with_env(mtcars, cyl) with_env <- function(env, expr) { .Call(rlang_eval, substitute(expr), as_environment(env, caller_env())) } #' @rdname with_env #' @export locally <- function(expr) { .Call(rlang_eval, substitute(expr), child_env(caller_env())) } #' Invoke a function with a list of arguments #' #' Normally, you invoke a R function by typing arguments manually. A #' powerful alternative is to call a function with a list of arguments #' assembled programmatically. This is the purpose of `invoke()`. #' #' Technically, `invoke()` is basically a version of [base::do.call()] #' that creates cleaner call traces because it does not inline the #' function and the arguments in the call (see examples). To achieve #' this, `invoke()` creates a child environment of `.env` with `.fn` #' and all arguments bound to new symbols (see [env_bury()]). It then #' uses the same strategy as [eval_bare()] to evaluate with minimal #' noise. #' #' #' @section Life cycle: #' #' `invoke()` is in questioning lifecycle stage. Now that we #' understand better the interaction between unquoting and dots #' capture, we believe that `invoke()` should not take a `.args` #' argument. Instead it should take dots with [dots_list()] in order #' to enable `!!!` syntax. #' #' We ask rlang users not to use `invoke()` in CRAN packages because #' we plan a breaking API update to remove the `.args` argument. #' #' @param .fn A function to invoke. Can be a function object or the #' name of a function in scope of `.env`. #' @param .args,... List of arguments (possibly named) to be passed to #' `.fn`. #' @param .env The environment in which to call `.fn`. #' @param .bury A character vector of length 2. The first string #' specifies which name should the function have in the call #' recorded in the evaluation stack. The second string specifies a #' prefix for the argument names. Set `.bury` to `NULL` if you #' prefer to inline the function and its arguments in the call. #' @export #' @examples #' # invoke() has the same purpose as do.call(): #' invoke(paste, letters) #' #' # But it creates much cleaner calls: #' invoke(call_inspect, mtcars) #' #' # and stacktraces: #' fn <- function(...) sys.calls() #' invoke(fn, list(mtcars)) #' #' # Compare to do.call(): #' do.call(call_inspect, mtcars) #' do.call(fn, list(mtcars)) #' #' #' # Specify the function name either by supplying a string #' # identifying the function (it should be visible in .env): #' invoke("call_inspect", letters) #' #' # Or by changing the .bury argument, with which you can also change #' # the argument prefix: #' invoke(call_inspect, mtcars, .bury = c("inspect!", "col")) invoke <- function(.fn, .args = list(), ..., .env = caller_env(), .bury = c(".fn", "")) { args <- c(.args, list(...)) if (is_null(.bury) || !length(args)) { if (is_scalar_character(.fn)) { .fn <- env_get(.env, .fn, inherit = TRUE) } call <- call2(.fn, !!! args) return(.Call(rlang_eval, call, .env)) } if (!is_character(.bury, 2L)) { abort("`.bury` must be a character vector of length 2") } arg_prefix <- .bury[[2]] fn_nm <- .bury[[1]] buried_nms <- paste0(arg_prefix, seq_along(args)) buried_args <- set_names(args, buried_nms) .env <- env_bury(.env, !!! buried_args) args <- set_names(buried_nms, names(args)) args <- syms(args) if (is_function(.fn)) { env_bind(.env, !! fn_nm := .fn) .fn <- fn_nm } call <- call2(.fn, !!! args) .Call(rlang_eval, call, .env) } rlang/R/vec-utils.R0000644000176200001440000000554013241305652013621 0ustar liggesusers#' Prepend a vector #' #' This is a companion to [base::append()] to help merging two lists #' or atomic vectors. `prepend()` is a clearer semantic signal than #' `c()` that a vector is to be merged at the beginning of another, #' especially in a pipe chain. #' #' #' @keywords internal #' @section Life cycle: #' #' `prepend()` is experimental, expect API changes. We are still #' figuring out what vector tools belong in rlang. #' #' @param x the vector to be modified. #' @param values to be included in the modified vector. #' @param before a subscript, before which the values are to be appended. #' #' @return A merged vector. #' @export #' @examples #' x <- as.list(1:3) #' #' append(x, "a") #' prepend(x, "a") #' prepend(x, list("a", "b"), before = 3) prepend <- function(x, values, before = 1) { n <- length(x) stopifnot(before > 0 && before <= n) if (before == 1) { c(values, x) } else { c(x[1:(before - 1)], values, x[before:n]) } } #' Modify a vector #' #' This function merges a list of arguments into a vector. It always #' returns a list. #' #' #' @keywords internal #' @section Life cycle: #' #' `modify()` is experimental, expect API changes. We are still #' figuring out what vector tools belong in rlang. #' #' @param .x A vector to modify. #' @param ... List of elements to merge into `.x`. Named elements #' already existing in `.x` are used as replacements. Elements that #' have new or no names are inserted at the end. These dots support #' [tidy dots][tidy-dots] features. #' #' @return A modified vector upcasted to a list. #' @export #' @examples #' modify(c(1, b = 2, 3), 4, b = "foo") #' #' x <- list(a = 1, b = 2) #' y <- list(b = 3, c = 4) #' modify(x, splice(y)) modify <- function(.x, ...) { out <- as.list(.x) args <- dots_list(...) args_nms <- names(args) exists <- have_name(args) & args_nms %in% names(out) for (nm in args_nms[exists]) { out[[nm]] <- args[[nm]] } c(out, args[!exists]) } #' Increasing sequence of integers in an interval #' #' These helpers take two endpoints and return the sequence of all #' integers within that interval. For `seq2_along()`, the upper #' endpoint is taken from the length of a vector. Unlike #' `base::seq()`, they return an empty vector if the starting point is #' a larger integer than the end point. #' #' @param from The starting point of the sequence. #' @param to The end point. #' @param x A vector whose length is the end point. #' @return An integer vector containing a strictly increasing #' sequence. #' @export #' @examples #' seq2(2, 10) #' seq2(10, 2) #' seq(10, 2) #' #' seq2_along(10, letters) seq2 <- function(from, to) { if (from > to) { int() } else { seq.int(from, to) } } #' @rdname seq2 #' @export seq2_along <- function(from, x) { seq2(from, length(x)) } first <- function(x) { .subset2(x, 1L) } last <- function(x) { .subset2(x, length_(x)) } rlang/R/c-api.R0000644000176200001440000000053513241233650012674 0ustar liggesusers c_constants_env <- new.env(parent = emptyenv()) init_c_constants <- function() { env_bind(c_constants_env, tilde_thunk_fmls = formals(function(...) NULL), tilde_thunk_body = expr((!!.Call)(!!(rlang_tilde_eval), sys.call(), "data_mask_arg", "data_mask_top_arg", environment() )) ) } rlang/R/env.R0000644000176200001440000011272113241305652012476 0ustar liggesusers#' Create a new environment #' #' @description #' #' These functions create new environments. #' #' * `env()` always creates a child of the current environment. #' #' * `child_env()` lets you specify a parent (see section on #' inheritance). #' #' * `new_environment()` creates a child of the empty environment. It #' is useful e.g. for using environments as containers of data #' rather than as part of a scope hierarchy. #' #' @section Environments as objects: #' #' Environments are containers of uniquely named objects. Their most #' common use is to provide a scope for the evaluation of R #' expressions. Not all languages have first class environments, #' i.e. can manipulate scope as regular objects. Reification of scope #' is one of the most powerful feature of R as it allows you to change #' what objects a function or expression sees when it is evaluated. #' #' Environments also constitute a data structure in their own #' right. They are a collection of uniquely named objects, subsettable #' by name and modifiable by reference. This latter property (see #' section on reference semantics) is especially useful for creating #' mutable OO systems (cf the [R6 package](https://github.com/wch/R6) #' and the [ggproto #' system](http://ggplot2.tidyverse.org/articles/extending-ggplot2.html) #' for extending ggplot2). #' #' @section Inheritance: #' #' All R environments (except the [empty environment][empty_env]) are #' defined with a parent environment. An environment and its #' grandparents thus form a linear hierarchy that is the basis for #' [lexical #' scoping](https://en.wikipedia.org/wiki/Scope_(computer_science)) in #' R. When R evaluates an expression, it looks up symbols in a given #' environment. If it cannot find these symbols there, it keeps #' looking them up in parent environments. This way, objects defined #' in child environments have precedence over objects defined in #' parent environments. #' #' The ability of overriding specific definitions is used in the #' tidyeval framework to create powerful domain-specific grammars. A #' common use of masking is to put data frame columns in scope. See #' for example [as_data_mask()]. #' #' @section Reference semantics: #' #' Unlike regular objects such as vectors, environments are an #' [uncopyable][is_copyable()] object type. This means that if you #' have multiple references to a given environment (by assigning the #' environment to another symbol with `<-` or passing the environment #' as argument to a function), modifying the bindings of one of those #' references changes all other references as well. #' #' @param ...,data Named values. These dots support [tidy #' dots][tidy-dots] features. #' @param .parent A parent environment. Can be an object supported by #' [as_environment()]. #' @seealso `scoped_env`, [env_has()], [env_bind()]. #' @export #' @examples #' # env() creates a new environment which has the current environment #' # as parent #' env <- env(a = 1, b = "foo") #' env$b #' identical(env_parent(env), get_env()) #' #' #' # child_env() lets you specify a parent: #' child <- child_env(env, c = "bar") #' identical(env_parent(child), env) #' #' # This child environment owns `c` but inherits `a` and `b` from `env`: #' env_has(child, c("a", "b", "c", "d")) #' env_has(child, c("a", "b", "c", "d"), inherit = TRUE) #' #' # `parent` is passed to as_environment() to provide handy #' # shortcuts. Pass a string to create a child of a package #' # environment: #' child_env("rlang") #' env_parent(child_env("rlang")) #' #' # Or `NULL` to create a child of the empty environment: #' child_env(NULL) #' env_parent(child_env(NULL)) #' #' # The base package environment is often a good default choice for a #' # parent environment because it contains all standard base #' # functions. Also note that it will never inherit from other loaded #' # package environments since R keeps the base package at the tail #' # of the search path: #' base_child <- child_env("base") #' env_has(base_child, c("lapply", "("), inherit = TRUE) #' #' # On the other hand, a child of the empty environment doesn't even #' # see a definition for `(` #' empty_child <- child_env(NULL) #' env_has(empty_child, c("lapply", "("), inherit = TRUE) #' #' # Note that all other package environments inherit from base_env() #' # as well: #' rlang_child <- child_env("rlang") #' env_has(rlang_child, "env", inherit = TRUE) # rlang function #' env_has(rlang_child, "lapply", inherit = TRUE) # base function #' #' #' # Both env() and child_env() support tidy dots features: #' objs <- list(b = "foo", c = "bar") #' env <- env(a = 1, !!! objs) #' env$c #' #' # You can also unquote names with the definition operator `:=` #' var <- "a" #' env <- env(!!var := "A") #' env$a #' #' #' # Use new_environment() to create containers with the empty #' # environment as parent: #' env <- new_environment() #' env_parent(env) #' #' # Like other new_ constructors, it takes an object rather than dots: #' new_environment(list(a = "foo", b = "bar")) env <- function(...) { env <- new.env(parent = caller_env()) env_bind_impl(env, dots_list(...)) } #' @rdname env #' @export child_env <- function(.parent, ...) { env <- new.env(parent = as_environment(.parent)) env_bind_impl(env, dots_list(...)) } #' @rdname env #' @export new_environment <- function(data = list()) { env <- new.env(parent = empty_env()) env_bind_impl(env, data) } #' Coerce to an environment #' #' `as_environment()` coerces named vectors (including lists) to an #' environment. It first checks that `x` is a dictionary (see #' [is_dictionaryish()]). If supplied an unnamed string, it returns the #' corresponding package environment (see [pkg_env()]). #' #' If `x` is an environment and `parent` is not `NULL`, the #' environment is duplicated before being set a new parent. The return #' value is therefore a different environment than `x`. #' #' #' @section Life cycle: #' #' `as_env()` was soft-deprecated and renamed to `as_environment()` in #' rlang 0.2.0. This is for consistency as type predicates should not #' be abbreviated. #' #' @param x An object to coerce. #' @param parent A parent environment, [empty_env()] by default. This #' argument is only used when `x` is data actually coerced to an #' environment (as opposed to data representing an environment, like #' `NULL` representing the empty environment). #' @export #' @examples #' # Coerce a named vector to an environment: #' env <- as_environment(mtcars) #' #' # By default it gets the empty environment as parent: #' identical(env_parent(env), empty_env()) #' #' #' # With strings it is a handy shortcut for pkg_env(): #' as_environment("base") #' as_environment("rlang") #' #' # With NULL it returns the empty environment: #' as_environment(NULL) as_environment <- function(x, parent = NULL) { coerce_type(x, "an environment", NULL = { empty_env() }, environment = { x }, string = { if (length(x) > 1 || is_named(x)) { return(as_env_(x, parent)) } pkg_env(x) }, logical = , integer = , double = , complex = , character = , raw = , list = { as_env_(x, parent) } ) } as_env_ <- function(x, parent = NULL) { stopifnot(is_dictionaryish(x)) if (is_atomic(x)) { x <- as_list(x) } list2env(x, parent = parent %||% empty_env()) } #' Get parent environments #' #' @description #' #' - `env_parent()` returns the parent environment of `env` if called #' with `n = 1`, the grandparent with `n = 2`, etc. #' #' - `env_tail()` searches through the parents and returns the one #' which has [empty_env()] as parent. #' #' - `env_parents()` returns the list of all parents, including the #' empty environment. #' #' See the section on _inheritance_ in [env()]'s documentation. #' #' @inheritParams get_env #' @param n The number of generations to go up. #' @param sentinel The environment signalling the end of the linear #' search. `env_tail()` returns the environment which has `sentinel` #' as parent. #' @return An environment for `env_parent()` and `env_tail()`, a list #' of environments for `env_parents()`. #' @export #' @examples #' # Get the parent environment with env_parent(): #' env_parent(global_env()) #' #' # Or the tail environment with env_tail(): #' env_tail(global_env()) #' #' # By default, env_parent() returns the parent environment of the #' # current evaluation frame. If called at top-level (the global #' # frame), the following two expressions are equivalent: #' env_parent() #' env_parent(base_env()) #' #' # This default is more handy when called within a function. In this #' # case, the enclosure environment of the function is returned #' # (since it is the parent of the evaluation frame): #' enclos_env <- env() #' fn <- set_env(function() env_parent(), enclos_env) #' identical(enclos_env, fn()) env_parent <- function(env = caller_env(), n = 1) { env_ <- get_env(env) while (n > 0) { if (is_empty_env(env_)) { return(env_) } n <- n - 1 env_ <- parent.env(env_) } env_ } #' @rdname env_parent #' @export env_tail <- function(env = caller_env(), sentinel = empty_env()) { env_ <- get_env(env) next_env <- parent.env(env_) while (!is_reference(next_env, sentinel)) { env_ <- next_env next_env <- parent.env(next_env) } env_ } #' @rdname env_parent #' @export env_parents <- function(env = caller_env()) { out <- new_list(env_depth(env)) i <- 1L while (!is_empty_env(env)) { env <- env_parent(env) out[[i]] <- env i <- i + 1L } out } #' Depth of an environment chain #' #' This function returns the number of environments between `env` and #' the [empty environment][empty_env()], including `env`. The depth of #' `env` is also the number of parents of `env` (since the empty #' environment counts as a parent). #' #' @inheritParams get_env #' @return An integer. #' @seealso The section on inheritance in [env()] documentation. #' @export #' @examples #' env_depth(empty_env()) #' env_depth(pkg_env("rlang")) env_depth <- function(env) { env_ <- get_env(env) n <- 0L while (!is_empty_env(env_)) { env_ <- env_parent(env_) n <- n + 1L } n } `_empty_env` <- emptyenv() is_empty_env <- function(env) { is_reference(env, `_empty_env`) } #' Get or set the environment of an object #' #' These functions dispatch internally with methods for functions, #' formulas and frames. If called with a missing argument, the #' environment of the current evaluation frame (see [ctxt_stack()]) is #' returned. If you call `get_env()` with an environment, it acts as #' the identity function and the environment is simply returned (this #' helps simplifying code when writing generic functions for #' environments). #' #' While `set_env()` returns a modified copy and does not have side #' effects, `env_poke_parent()` operates changes the environment by #' side effect. This is because environments are #' [uncopyable][is_copyable]. Be careful not to change environments #' that you don't own, e.g. a parent environment of a function from a #' package. #' #' @param env An environment or an object bundling an environment, #' e.g. a formula, [quosure][quotation] or [closure][is_closure]. #' @param default The default environment in case `env` does not wrap #' an environment. If `NULL` and no environment could be extracted, #' an error is issued. #' #' @seealso [quo_get_env()] and [quo_set_env()] for versions of #' [get_env()] and [set_env()] that only work on quosures. #' @export #' @examples #' # Get the environment of frame objects. If no argument is supplied, #' # the current frame is used: #' fn <- function() { #' list( #' get_env(call_frame()), #' get_env() #' ) #' } #' fn() #' #' # Environment of closure functions: #' get_env(fn) #' #' # Or of quosures or formulas: #' get_env(~foo) #' get_env(quo(foo)) #' #' #' # Provide a default in case the object doesn't bundle an environment. #' # Let's create an unevaluated formula: #' f <- quote(~foo) #' #' # The following line would fail if run because unevaluated formulas #' # don't bundle an environment (they didn't have the chance to #' # record one yet): #' # get_env(f) #' #' # It is often useful to provide a default when you're writing #' # functions accepting formulas as input: #' default <- env() #' identical(get_env(f, default), default) get_env <- function(env = caller_env(), default = NULL) { out <- switch_type(env, environment = env, definition = , formula = attr(env, ".Environment"), primitive = base_env(), closure = environment(env), list = switch_class(env, frame = env$env) ) out <- out %||% default if (is_null(out)) { type <- friendly_type(type_of(env)) abort(paste0("Can't extract an environment from ", type)) } else { out } } #' @rdname get_env #' @param new_env An environment to replace `env` with. Can be an #' object handled by `get_env()`. #' @export #' @examples #' #' # set_env() can be used to set the enclosure of functions and #' # formulas. Let's create a function with a particular environment: #' env <- child_env("base") #' fn <- set_env(function() NULL, env) #' #' # That function now has `env` as enclosure: #' identical(get_env(fn), env) #' identical(get_env(fn), get_env()) #' #' # set_env() does not work by side effect. Setting a new environment #' # for fn has no effect on the original function: #' other_env <- child_env(NULL) #' set_env(fn, other_env) #' identical(get_env(fn), other_env) #' #' # Since set_env() returns a new function with a different #' # environment, you'll need to reassign the result: #' fn <- set_env(fn, other_env) #' identical(get_env(fn), other_env) set_env <- function(env, new_env = caller_env()) { switch_type(env, definition = , formula = , closure = { environment(env) <- get_env(new_env) env }, environment = get_env(new_env), abort(paste0( "Can't set environment for ", friendly_type(type_of(env)), "" )) ) } #' @rdname get_env #' @export env_poke_parent <- function(env, new_env) { .Call(rlang_env_poke_parent, get_env(env), get_env(new_env)) } `env_parent<-` <- function(x, value) { .Call(rlang_env_poke_parent, get_env(x), value) } #' Bind symbols to objects in an environment #' #' @description #' #' These functions create bindings in an environment. The bindings are #' supplied through `...` as pairs of names and values or expressions. #' `env_bind()` is equivalent to evaluating a `<-` expression within #' the given environment. This function should take care of the #' majority of use cases but the other variants can be useful for #' specific problems. #' #' - `env_bind()` takes named _values_ which are bound in `.env`. #' `env_bind()` is equivalent to [base::assign()]. #' #' - `env_bind_fns()` takes named _functions_ and creates active #' bindings in `.env`. This is equivalent to #' [base::makeActiveBinding()]. An active binding executes a #' function each time it is evaluated. `env_bind_fns()` takes dots #' with [implicit splicing][dots_splice], so that you can supply #' both named functions and named lists of functions. #' #' If these functions are [closures][is_closure] they are lexically #' scoped in the environment that they bundle. These functions can #' thus refer to symbols from this enclosure that are not actually #' in scope in the dynamic environment where the active bindings are #' invoked. This allows creative solutions to difficult problems #' (see the implementations of `dplyr::do()` methods for an #' example). #' #' - `env_bind_exprs()` takes named _expressions_. This is equivalent #' to [base::delayedAssign()]. The arguments are captured with #' [exprs()] (and thus support call-splicing and unquoting) and #' assigned to symbols in `.env`. These expressions are not #' evaluated immediately but lazily. Once a symbol is evaluated, the #' corresponding expression is evaluated in turn and its value is #' bound to the symbol (the expressions are thus evaluated only #' once, if at all). #' #' @section Side effects: #' #' Since environments have reference semantics (see relevant section #' in [env()] documentation), modifying the bindings of an environment #' produces effects in all other references to that environment. In #' other words, `env_bind()` and its variants have side effects. #' #' As they are called primarily for their side effects, these #' functions follow the convention of returning their input invisibly. #' #' @param .env An environment or an object bundling an environment, #' e.g. a formula, [quosure][quotation] or [closure][is_closure]. #' This argument is passed to [get_env()]. #' @param ... Pairs of names and expressions, values or functions. #' These dots support [tidy dots][tidy-dots] features. #' @return The input object `.env`, with its associated environment #' modified in place, invisibly. #' @export #' @examples #' # env_bind() is a programmatic way of assigning values to symbols #' # with `<-`. We can add bindings in the current environment: #' env_bind(get_env(), foo = "bar") #' foo #' #' # Or modify those bindings: #' bar <- "bar" #' env_bind(get_env(), bar = "BAR") #' bar #' #' # It is most useful to change other environments: #' my_env <- env() #' env_bind(my_env, foo = "foo") #' my_env$foo #' #' # A useful feature is to splice lists of named values: #' vals <- list(a = 10, b = 20) #' env_bind(my_env, !!! vals, c = 30) #' my_env$b #' my_env$c #' #' # You can also unquote a variable referring to a symbol or a string #' # as binding name: #' var <- "baz" #' env_bind(my_env, !!var := "BAZ") #' my_env$baz #' #' #' # env_bind() and its variants are generic over formulas, quosures #' # and closures. To illustrate this, let's create a closure function #' # referring to undefined bindings: #' fn <- function() list(a, b) #' fn <- set_env(fn, child_env("base")) #' #' # This would fail if run since `a` etc are not defined in the #' # enclosure of fn() (a child of the base environment): #' # fn() #' #' # Let's define those symbols: #' env_bind(fn, a = "a", b = "b") #' #' # fn() now sees the objects: #' fn() env_bind <- function(.env, ...) { invisible(env_bind_impl(.env, dots_list(...))) } env_bind_impl <- function(env, data) { if (!is_vector(data) || (length(data) && !is_named(data))) { abort("Can't bind data because it is not uniquely named") } nms <- names(data) env_ <- get_env(env) for (i in seq_along(data)) { nm <- nms[[i]] base::assign(nm, data[[nm]], envir = env_) } env } # FIXME: Should these be env_bind_promises() and env_bind_actives()? #' Bind lazy or active bindings #' #' @keywords internal #' @section Life cycle: #' #' These functions are experimental. Expect API changes. #' #' @inheritParams env_bind #' @param .eval_env The environment where the expressions will be #' evaluated when the symbols are forced. #' @export #' @examples #' #' # env_bind_exprs() assigns expressions lazily: #' env <- env() #' env_bind_exprs(env, name = cat("forced!\n")) #' env$name #' env$name #' #' # You can unquote expressions. Note that quosures are not #' # supported, only raw expressions: #' expr <- quote(message("forced!")) #' env_bind_exprs(env, name = !! expr) #' env$name env_bind_exprs <- function(.env, ..., .eval_env = caller_env()) { exprs <- exprs(...) stopifnot(is_named(exprs)) nms <- names(exprs) env_ <- get_env(.env) for (i in seq_along(exprs)) { do.call("delayedAssign", list( x = nms[[i]], value = exprs[[i]], eval.env = .eval_env, assign.env = env_ )) } invisible(.env) } #' @rdname env_bind_exprs #' @export #' @examples #' #' # You can create active bindings with env_bind_fns() #' # Let's create some bindings in the lexical enclosure of `fn`: #' counter <- 0 #' #' # And now a function that increments the counter and returns a #' # string with the count: #' fn <- function() { #' counter <<- counter + 1 #' paste("my counter:", counter) #' } #' #' # Now we create an active binding in a child of the current #' # environment: #' env <- env() #' env_bind_fns(env, symbol = fn) #' #' # `fn` is executed each time `symbol` is evaluated or retrieved: #' env$symbol #' env$symbol #' eval_bare(quote(symbol), env) #' eval_bare(quote(symbol), env) env_bind_fns <- function(.env, ...) { fns <- dots_splice(...) stopifnot(is_named(fns) && every(fns, is_function)) nms <- names(fns) env_ <- get_env(.env) for (i in seq_along(fns)) { makeActiveBinding(nms[[i]], fns[[i]], env_) } invisible(.env) } #' Temporarily change bindings of an environment #' #' @description #' #' * `scoped_bindings()` temporarily changes bindings in `.env` (which #' is by default the caller environment). The bindings are reset to #' their original values when the current frame (or an arbitrary one #' if you specify `.frame`) goes out of scope. #' #' * `with_bindings()` evaluates `expr` with temporary bindings. When #' `with_bindings()` returns, bindings are reset to their original #' values. It is a simple wrapper around `scoped_bindings()`. #' #' @inheritParams env_bind #' @param ... Pairs of names and values. These dots support splicing #' (with value semantics) and name unquoting. #' @param .frame The frame environment that determines the scope of #' the temporary bindings. When that frame is popped from the call #' stack, bindings are switched back to their original values. #' @return `scoped_bindings()` returns the values of old bindings #' invisibly; `with_bindings()` returns the value of `expr`. #' @export #' @examples #' foo <- "foo" #' bar <- "bar" #' #' # `foo` will be temporarily rebinded while executing `expr` #' with_bindings(paste(foo, bar), foo = "rebinded") #' paste(foo, bar) scoped_bindings <- function(..., .env = .frame, .frame = caller_env()) { env <- get_env(.env) bindings <- dots_list(...) stopifnot(is_named(bindings)) nms <- names(bindings) is_old <- env_has(env, nms) old <- env_get_list(env, nms[is_old]) unbind_lang <- call2(env_unbind, env, nms[!is_old]) rebind_lang <- call2(env_bind_impl, env, old) scoped_exit(frame = .frame, { !! unbind_lang !! rebind_lang }) env_bind_impl(env, bindings) invisible(old) } #' @rdname scoped_bindings #' @param .expr An expression to evaluate with temporary bindings. #' @export with_bindings <- function(.expr, ..., .env = caller_env()) { scoped_bindings(..., .env = .env) .expr } #' Mask bindings by defining symbols deeper in a scope #' #' `env_bury()` is like [env_bind()] but it creates the bindings in a #' new child environment. This makes sure the new bindings have #' precedence over old ones, without altering existing environments. #' Unlike `env_bind()`, this function does not have side effects and #' returns a new environment (or object wrapping that environment). #' #' @inheritParams env_bind #' @return A copy of `.env` enclosing the new environment containing #' bindings to `...` arguments. #' @seealso [env_bind()], [env_unbind()] #' @export #' @examples #' orig_env <- env(a = 10) #' fn <- set_env(function() a, orig_env) #' #' # fn() currently sees `a` as the value `10`: #' fn() #' #' # env_bury() will bury the current scope of fn() behind a new #' # environment: #' fn <- env_bury(fn, a = 1000) #' fn() #' #' # Even though the symbol `a` is still defined deeper in the scope: #' orig_env$a env_bury <- function(.env, ...) { env_ <- get_env(.env) env_ <- child_env(env_, ...) set_env(.env, env_) } #' Remove bindings from an environment #' #' `env_unbind()` is the complement of [env_bind()]. Like `env_has()`, #' it ignores the parent environments of `env` by default. Set #' `inherit` to `TRUE` to track down bindings in parent environments. #' #' @inheritParams get_env #' @param nms A character vector containing the names of the bindings #' to remove. #' @param inherit Whether to look for bindings in the parent #' environments. #' @return The input object `env` with its associated environment #' modified in place, invisibly. #' @export #' @examples #' data <- set_names(as_list(letters), letters) #' env_bind(environment(), !!! data) #' env_has(environment(), letters) #' #' # env_unbind() removes bindings: #' env_unbind(environment(), letters) #' env_has(environment(), letters) #' #' # With inherit = TRUE, it removes bindings in parent environments #' # as well: #' parent <- child_env(NULL, foo = "a") #' env <- child_env(parent, foo = "b") #' env_unbind(env, "foo", inherit = TRUE) #' env_has(env, "foo", inherit = TRUE) env_unbind <- function(env = caller_env(), nms, inherit = FALSE) { env_ <- get_env(env) if (inherit) { while (any(env_has(env_, nms, inherit = TRUE))) { rm(list = nms, envir = env, inherits = TRUE) } } else { rm(list = nms, envir = env) } invisible(env) } #' Does an environment have or see bindings? #' #' `env_has()` is a vectorised predicate that queries whether an #' environment owns bindings personally (with `inherit` set to #' `FALSE`, the default), or sees them in its own environment or in #' any of its parents (with `inherit = TRUE`). #' #' @inheritParams env_unbind #' @return A logical vector as long as `nms`. #' @export #' @examples #' parent <- child_env(NULL, foo = "foo") #' env <- child_env(parent, bar = "bar") #' #' # env does not own `foo` but sees it in its parent environment: #' env_has(env, "foo") #' env_has(env, "foo", inherit = TRUE) env_has <- function(env = caller_env(), nms, inherit = FALSE) { map_lgl(nms, exists, envir = get_env(env), inherits = inherit) } #' Get an object in an environment #' #' `env_get()` extracts an object from an enviroment `env`. By #' default, it does not look in the parent environments. #' `env_get_list()` extracts multiple objects from an environment into #' a named list. #' #' @inheritParams get_env #' @inheritParams env_has #' @param nm,nms Names of bindings. `nm` must be a single string. #' @return An object if it exists. Otherwise, throws an error. #' @export #' @examples #' parent <- child_env(NULL, foo = "foo") #' env <- child_env(parent, bar = "bar") #' #' # This throws an error because `foo` is not directly defined in env: #' # env_get(env, "foo") #' #' # However `foo` can be fetched in the parent environment: #' env_get(env, "foo", inherit = TRUE) env_get <- function(env = caller_env(), nm, inherit = FALSE) { get(nm, envir = get_env(env), inherits = inherit) } #' @rdname env_get #' @export env_get_list <- function(env = caller_env(), nms, inherit = FALSE) { nms <- set_names(nms) map(nms, env_get, env = env, inherit = inherit) } #' Poke an object in an environment #' #' `env_poke()` will assign or reassign a binding in `env` if `create` #' is `TRUE`. If `create` is `FALSE` and a binding does not already #' exists, an error is issued. #' #' If `inherit` is `TRUE`, the parents environments are checked for #' an existing binding to reassign. If not found and `create` is #' `TRUE`, a new binding is created in `env`. The default value for #' `create` is a function of `inherit`: `FALSE` when inheriting, #' `TRUE` otherwise. #' #' This default makes sense because the inheriting case is mostly #' for overriding an existing binding. If not found, something #' probably went wrong and it is safer to issue an error. Note that #' this is different to the base R operator `<<-` which will create #' a binding in the global environment instead of the current #' environment when no existing binding is found in the parents. #' #' #' @section Life cycle: #' #' `env_poke()` is experimental. We are still experimenting with #' reducing the number of redundant functions by using quasiquotation. #' It is possible `env_poke()` will be deprecated in favour of #' `env_bind()` and name-unquoting with `:=`. #' #' @inheritParams env_get #' @param value The value for a new binding. #' @param create Whether to create a binding if it does not already #' exist in the environment. #' #' @keywords internal #' @export env_poke <- function(env = caller_env(), nm, value, inherit = FALSE, create = NULL) { stopifnot(is_string(nm)) env_ <- get_env(env) # It is safer not to create a new binding when inherit is TRUE, # since the main purpose is to override an existing binding if (is_null(create)) { create <- if (inherit) FALSE else TRUE } if (inherit) { scope_set(env, nm, value, create) } else if (create || env_has(env_, nm)) { assign(nm, value, envir = env_) } else { abort(paste0("Can't find existing binding in `env` for \"", nm, "\"")) } env } scope_set <- function(env, nm, value, create) { env_ <- get_env(env) cur <- env_ while (!env_has(cur, nm) && !is_empty_env(cur)) { cur <- env_parent(cur) } if (is_empty_env(cur)) { if (!create) { abort(paste0("Can't find existing binding in `env` for \"", nm, "\"")) } cur <- env_ } assign(nm, value, envir = cur) env } #' Names of symbols bound in an environment #' #' `env_names()` returns object names from an enviroment `env` as a #' character vector. All names are returned, even those starting with #' a dot. #' #' @section Names of symbols and objects: #' #' Technically, objects are bound to symbols rather than strings, #' since the R interpreter evaluates symbols (see [is_expression()] for a #' discussion of symbolic objects versus literal objects). However it #' is often more convenient to work with strings. In rlang #' terminology, the string corresponding to a symbol is called the #' _name_ of the symbol (or by extension the name of an object bound #' to a symbol). #' #' @section Encoding: #' #' There are deep encoding issues when you convert a string to symbol #' and vice versa. Symbols are _always_ in the native encoding (see #' [set_chr_encoding()]). If that encoding (let's say latin1) cannot #' support some characters, these characters are serialised to #' ASCII. That's why you sometimes see strings looking like #' ``, especially if you're running Windows (as R doesn't #' support UTF-8 as native encoding on that platform). #' #' To alleviate some of the encoding pain, `env_names()` always #' returns a UTF-8 character vector (which is fine even on Windows) #' with unicode points unserialised. #' #' @inheritParams get_env #' @return A character vector of object names. #' @export #' @examples #' env <- env(a = 1, b = 2) #' env_names(env) env_names <- function(env) { nms <- names(get_env(env)) .Call(rlang_unescape_character, nms) } #' Clone an environment #' #' This creates a new environment containing exactly the same objects, #' optionally with a new parent. #' #' @inheritParams get_env #' @param parent The parent of the cloned environment. #' @export #' @examples #' env <- env(!!! mtcars) #' clone <- env_clone(env) #' identical(env, clone) #' identical(env$cyl, clone$cyl) env_clone <- function(env, parent = env_parent(env)) { .Call(rlang_env_clone, get_env(env), parent) } #' Does environment inherit from another environment? #' #' This returns `TRUE` if `x` has `ancestor` among its parents. #' #' @inheritParams get_env #' @param ancestor Another environment from which `x` might inherit. #' @export env_inherits <- function(env, ancestor) { env <- get_env(env) stopifnot(is_env(ancestor) && is_env(env)) while (!is_empty_env(env_parent(env))) { env <- env_parent(env) if (is_reference(env, ancestor)) { return(TRUE) } } is_empty_env(env) } #' Scoped environments #' #' @description #' #' Scoped environments are named environments which form a #' parent-child hierarchy called the search path. They define what #' objects you can see (are in scope) from your workspace. They #' typically are package environments, i.e. special environments #' containing all exported functions from a package (and whose parent #' environment is the package namespace, which also contains #' unexported functions). Package environments are attached to the #' search path with [base::library()]. Note however that any #' environment can be attached to the search path, for example with #' the unrecommended [base::attach()] base function which transforms #' vectors to scoped environments. #' #' - You can list all scoped environments with `scoped_names()`. Unlike #' [base::search()], it also mentions the empty environment that #' terminates the search path (it is given the name `"NULL"`). #' #' - `scoped_envs()` returns all environments on the search path, #' including the empty environment. #' #' - `pkg_env()` takes a package name and returns the scoped #' environment of packages if they are attached to the search path, #' and throws an error otherwise. #' #' - `is_scoped()` allows you to check whether a named environment is #' on the search path. #' #' #' @section Search path: #' #' The search path is a chain of scoped environments where newly #' attached environments are the childs of earlier ones. However, the #' global environment, where everything you define at top-level ends #' up, is pinned as the head of that linked chain. Likewise, the base #' package environment is pinned as the tail of the chain. You can #' retrieve those environments with `global_env()` and `base_env()` #' respectively. The global environment is also the environment of the #' very first evaluation frame on the stack, see [global_frame()] and #' [ctxt_stack()]. #' #' #' @section Life cycle: #' #' These functions are experimental and may not belong to the rlang #' package. Expect API changes. #' #' @param nm The name of an environment attached to the search #' path. Call [base::search()] to see what is currently on the path. #' #' @keywords internal #' @export #' @examples #' # List the names of scoped environments: #' nms <- scoped_names() #' nms #' #' # The global environment is always the first in the chain: #' scoped_env(nms[[1]]) #' #' # And the scoped environment of the base package is always the last: #' scoped_env(nms[[length(nms)]]) #' #' # These two environments have their own shortcuts: #' global_env() #' base_env() #' #' # Packages appear in the search path with a special name. Use #' # pkg_env_name() to create that name: #' pkg_env_name("rlang") #' scoped_env(pkg_env_name("rlang")) #' #' # Alternatively, get the scoped environment of a package with #' # pkg_env(): #' pkg_env("utils") scoped_env <- function(nm) { if (identical(nm, "NULL")) { return(empty_env()) } if (!is_scoped(nm)) { stop(paste0(nm, " is not in scope"), call. = FALSE) } as.environment(nm) } #' @rdname scoped_env #' @param pkg The name of a package. #' @export pkg_env <- function(pkg) { pkg_name <- pkg_env_name(pkg) scoped_env(pkg_name) } #' @rdname scoped_env #' @export pkg_env_name <- function(pkg) { paste0("package:", pkg) } #' @rdname scoped_env #' @export scoped_names <- function() { c(search(), "NULL") } #' @rdname scoped_env #' @export scoped_envs <- function() { envs <- c(.GlobalEnv, env_parents(.GlobalEnv)) set_names(envs, scoped_names()) } #' @rdname scoped_env #' @export is_scoped <- function(nm) { if (!is_scalar_character(nm)) { stop("`nm` must be a string", call. = FALSE) } nm %in% scoped_names() } #' @rdname scoped_env #' @export base_env <- baseenv #' @rdname scoped_env #' @export global_env <- globalenv #' Get the empty environment #' #' The empty environment is the only one that does not have a parent. #' It is always used as the tail of a scope chain such as the search #' path (see [scoped_names()]). #' #' @export #' @examples #' # Create environments with nothing in scope: #' child_env(empty_env()) empty_env <- emptyenv #' Get the namespace of a package #' #' Namespaces are the environment where all the functions of a package #' live. The parent environments of namespaces are the `imports` #' environments, which contain all the functions imported from other #' packages. #' #' #' @section Life cycle: #' #' These functions are experimental and may not belong to the rlang #' package. Expect API changes. #' #' @param pkg The name of a package. If `NULL`, the surrounding #' namespace is returned, or an error is issued if not called within #' a namespace. If a function, the enclosure of that function is #' checked. #' #' @seealso [pkg_env()] #' @keywords internal #' @export ns_env <- function(pkg = NULL) { if (is_null(pkg)) { bottom <- topenv(caller_env()) if (!isNamespace(bottom)) abort("not in a namespace") bottom } else if (is_function(pkg)) { env <- env_parent(pkg) if (isNamespace(env)) { env } else { NULL } } else { asNamespace(pkg) } } #' @rdname ns_env #' @export ns_imports_env <- function(pkg = NULL) { env_parent(ns_env(pkg)) } #' @rdname ns_env #' @export ns_env_name <- function(pkg = NULL) { if (is_null(pkg)) { pkg <- with_env(caller_env(), ns_env()) } else if (is_function(pkg)) { pkg <- get_env(pkg) } unname(getNamespaceName(pkg)) } #' Is an object a namespace environment? #' #' @param x An object to test. #' @export is_namespace <- function(x) { isNamespace(x) } #' Is a package installed in the library? #' #' This checks that a package is installed with minimal side effects. #' If installed, the package will be loaded but not attached. #' #' @param pkg The name of a package. #' @return `TRUE` if the package is installed, `FALSE` otherwise. #' @export #' @examples #' is_installed("utils") #' is_installed("ggplot5") is_installed <- function(pkg) { is_true(requireNamespace(pkg, quietly = TRUE)) } env_type <- function(env) { if (is_reference(env, global_env())) { "global" } else if (is_reference(env, empty_env())) { "empty" } else if (is_reference(env, base_env())) { "base" } else if (is_frame_env(env)) { "frame" } else { "local" } } friendly_env_type <- function(type) { switch(type, global = "the global environment", empty = "the empty environment", base = "the base environment", frame = "a frame environment", local = "a local environment", abort("Internal error: unknown environment type") ) } env_format <- function(env) { type <- env_type(env) if (type %in% c("frame", "local")) { addr <- sxp_address(get_env(env)) type <- paste(type, addr) } type } rlang/R/events.R0000644000176200001440000000076013241233650013207 0ustar liggesusers scoped_exit <- function(expr, frame = caller_env()) { expr <- enexpr(expr) # We are at top-level when only one frame refers to the global environment if (is_reference(frame, global_env())) { is_global_frame <- sys.parents() == 0 if (sum(is_global_frame) == 1) { abort("Can't add an exit event at top-level") } } # Inline everything so the call will succeed in any environment expr <- call2(on.exit, expr, add = TRUE) eval_bare(expr, frame) invisible(expr) } rlang/R/sexp.R0000644000176200001440000000327713241233650012670 0ustar liggesusers#' Duplicate an R object #' #' In R semantics, objects are copied by value. This means that #' modifying the copy leaves the original object intact. Since, #' copying data in memory is an expensive operation, copies in R are #' as lazy as possible. They only happen when the new object is #' actually modified. However, some operations (like [node_poke_car()] #' or [node_poke_cdr()]) do not support copy-on-write. In those cases, #' it is necessary to duplicate the object manually in order to #' preserve copy-by-value semantics. #' #' Some objects are not duplicable, like symbols and environments. #' `duplicate()` returns its input for these unique objects. #' #' @param x Any R object. However, uncopyable types like symbols and #' environments are returned as is (just like with `<-`). #' @param shallow This is relevant for recursive data structures like #' lists, calls and pairlists. A shallow copy only duplicates the #' top-level data structure. The objects contained in the list are #' still the same. #' @seealso pairlist #' @keywords internal #' @export duplicate <- function(x, shallow = FALSE) { .Call(rlang_duplicate, x, shallow) } # nocov start - These functions are mostly for interactive experimentation poke_type <- function(x, type) { invisible(.Call(rlang_poke_type, x, type)) } sxp_address <- function(x) { .Call(rlang_sxp_address, x) } mark_object <- function(x) { invisible(.Call(rlang_mark_object, x)) } unmark_object <- function(x) { invisible(.Call(rlang_unmark_object, x)) } true_length <- function(x) { .Call(rlang_true_length, x) } env_frame <- function(x) { .Call(rlang_env_frame, x) } env_hash_table <- function(x) { .Call(rlang_env_hash_table, x) } # nocov end rlang/R/eval-tidy.R0000644000176200001440000002556713241233650013615 0ustar liggesusers#' Evaluate an expression with quosures and pronoun support #' #' @description #' #' `eval_tidy()` is a variant of [base::eval()] that powers the tidy #' evaluation framework. Like `eval()` it accepts user data as #' argument. If supplied, it evaluates its input `expr` in a [data #' mask][as_data_mask]. In additon `eval_tidy()` supports: #' #' - [Quosures][quotation]. The expression wrapped in the quosure #' evaluates in its original context (masked by `data` if supplied). #' #' - [Pronouns][.data]. If `data` is supplied, the `.env` and `.data` #' pronouns are installed in the data mask. `.env` is a reference to #' the calling environment and `.data` refers to the `data` argument. #' These pronouns lets you be explicit about where to find #' values and throw errors if you try to access non-existent values. #' #' #' @section Life cycle: #' #' `eval_tidy()` is stable. #' #' @param expr An expression to evaluate. #' @param data A data frame, or named list or vector. Alternatively, a #' data mask created with [as_data_mask()] or [new_data_mask()]. #' @param env The environment in which to evaluate `expr`. This #' environment is always ignored when evaluating quosures. Quosures #' are evaluated in their own environment. #' @seealso [quasiquotation] for the second leg of the tidy evaluation #' framework. #' @export #' @examples #' # With simple quoted expressions eval_tidy() works the same way as #' # eval(): #' apple <- "apple" #' kiwi <- "kiwi" #' expr <- quote(paste(apple, kiwi)) #' expr #' #' eval(expr) #' eval_tidy(expr) #' #' # Both accept a data mask as argument: #' data <- list(apple = "CARROT", kiwi = "TOMATO") #' eval(expr, data) #' eval_tidy(expr, data) #' #' #' # In addition eval_tidy() has support for quosures: #' with_data <- function(data, expr) { #' quo <- enquo(expr) #' eval_tidy(quo, data) #' } #' with_data(NULL, apple) #' with_data(data, apple) #' with_data(data, list(apple, kiwi)) #' #' # Secondly eval_tidy() installs handy pronouns that allows users to #' # be explicit about where to find symbols: #' with_data(data, .data$apple) #' with_data(data, .env$apple) #' #' #' # Note that instead of using `.env` it is often equivalent and may #' # be preferred to unquote a value. There are two differences. First #' # unquoting happens earlier, when the quosure is created. Secondly, #' # subsetting `.env` with the `$` operator may be brittle because #' # `$` does not look through the parents of the environment. #' # #' # For instance using `.env$name` in a magrittr pipeline is an #' # instance where this poses problem, because the magrittr pipe #' # currently (as of v1.5.0) evaluates its operands in a *child* of #' # the current environment (this child environment is where it #' # defines the pronoun `.`). #' \dontrun{ #' data %>% with_data(!!kiwi) # "kiwi" #' data %>% with_data(.env$kiwi) # NULL #' } #' @name eval_tidy eval_tidy <- function(expr, data = NULL, env = caller_env()) { .Call(rlang_eval_tidy, expr, data, environment()) } #' Data pronoun for tidy evaluation #' #' @description #' #' This pronoun allows you to be explicit when you refer to an object #' inside the data. Referring to the `.data` pronoun rather than to #' the original data frame has several advantages: #' #' * Sometimes a computation is not about the whole data but about a #' subset. For example if you supply a grouped data frame to a dplyr #' verb, the `.data` pronoun contains the group subset. #' #' * It lets dplyr know that you're referring to a column from the #' data which is helpful to generate correct queries when the source #' is a database. #' #' The `.data` object exported here is useful to import in your #' package namespace to avoid a `R CMD check` note when referring to #' objects from the data mask. #' #' @name tidyeval-data #' @export .data <- NULL delayedAssign(".data", as_data_pronoun(list())) #' Create a data mask #' #' @description #' #' A data mask is an environment (or possibly multiple environments #' forming an ancestry) containing user-supplied objects. Objects in #' the mask have precedence over objects in the environment (i.e. they #' mask those objects). Many R functions evaluate quoted expressions #' in a data mask so these expressions can refer to objects within the #' user data. #' #' These functions let you construct a tidy eval data mask manually. #' They are meant for developers of tidy eval interfaces rather than #' for end users. Most of the time you can just call [eval_tidy()] #' with user data and the data mask will be constructed automatically. #' There are three main use cases for manual creation of data masks: #' #' * When [eval_tidy()] is called with the same data in a tight loop. #' Tidy eval data masks are a bit expensive to build so it is best #' to construct it once and reuse it the other times for optimal #' performance. #' #' * When several expressions should be evaluated in the same #' environment because a quoted expression might create new objects #' that can be referred in other quoted expressions evaluated at a #' later time. #' #' * When your data mask requires special features. For instance the #' data frame columns in dplyr data masks are implemented with #' [active bindings][base::delayedAssign]. #' #' #' @section Building your own data mask: #' #' Creating a data mask for [base::eval()] is a simple matter of #' creating an environment containing masking objects that has the #' user context as parent. `eval()` automates this task when you #' supply data as second argument. However a tidy eval data mask also #' needs to enable support of [quosures][quotation] and [data #' pronouns][tidyeval-data]. These functions allow manual construction #' of tidy eval data masks: #' #' * `as_data_mask()` transforms a data frame, named vector or #' environment to a data mask. If an environment, its ancestry is #' ignored. It automatically installs a data pronoun. #' #' * `new_data_mask()` is a bare bones data mask constructor for #' environments. You can supply a bottom and a top environment in #' case your data mask comprises multiple environments. #' #' Unlike `as_data_mask()` it does not install the `.data` pronoun #' so you need to provide one yourself. You can provide a pronoun #' constructed with `as_data_pronoun()` or your own pronoun class. #' #' - `as_data_pronoun()` constructs a tidy eval data pronoun that #' gives more useful error messages than regular data frames or #' lists, i.e. when an object does not exist or if an user tries to #' overwrite an object. #' #' To use a a data mask, just supply it to [eval_tidy()] as `data` #' argument. You can repeat this as many times as needed. Note that #' any objects created there (perhaps because of a call to `<-`) will #' persist in subsequent evaluations: #' #' #' @section Life cycle: #' #' All these functions are now stable. #' #' In early versions of rlang data masks were called overscopes. We #' think data mask is a more natural name in R. It makes reference to #' masking in the search path which occurs through the same mechanism #' (in technical terms, lexical scoping with hierarchically nested #' environments). We say that that objects from user data mask objects #' in the current environment. #' #' Following this change in terminology, `as_data_mask()` and #' `new_overscope()` were soft-deprecated in rlang 0.2.0 in favour of #' `as_data_mask()` and `new_data_mask()`. #' #' @param data A data frame or named vector of masking data. #' @param parent The parent environment of the data mask. #' @return A data mask that you can supply to [eval_tidy()]. #' #' @export #' @examples #' # Evaluating in a tidy evaluation environment enables all tidy #' # features: #' mask <- as_data_mask(mtcars) #' eval_tidy(quo(letters), mask) #' #' # You can install new pronouns in the mask: #' mask$.pronoun <- as_data_pronoun(list(foo = "bar", baz = "bam")) #' eval_tidy(quo(.pronoun$foo), mask) #' #' # In some cases the data mask can leak to the user, for example if #' # a function or formula is created in the data mask environment: #' cyl <- "user variable from the context" #' fn <- eval_tidy(quote(function() cyl), mask) #' fn() #' #' # If new objects are created in the mask, they persist in the #' # subsequent calls: #' eval_tidy(quote(new <- cyl + am), mask) #' eval_tidy(quote(new * 2), mask) as_data_mask <- function(data, parent = base_env()) { .Call(rlang_as_data_mask, data, parent) } #' @rdname as_data_mask #' @export as_data_pronoun <- function(data) { .Call(rlang_as_data_pronoun, data) } #' @rdname as_data_mask #' @param bottom The environment containing masking objects if the #' data mask is one environment deep. The bottom environment if the #' data mask comprises multiple environment. #' @param top The last environment of the data mask. If the data mask #' is only one environment deep, `top` should be the same as #' `bottom`. #' @export new_data_mask <- function(bottom, top = bottom, parent = base_env()) { .Call(rlang_new_data_mask, bottom, top, parent) } #' @export `$.rlang_data_pronoun` <- function(x, name) { src <- .subset2(x, "src") if (!has_binding(src, name)) { abort(sprintf(.subset2(x, "lookup_msg"), name), "rlang_data_pronoun_not_found") } src[[name]] } #' @export `[[.rlang_data_pronoun` <- function(x, i, ...) { if (!is_string(i)) { abort("Must subset the data pronoun with a string") } src <- .subset2(x, "src") if (!has_binding(src, i)) { abort(sprintf(.subset2(x, "lookup_msg"), i), "rlang_data_pronoun_not_found") } src[[i, ...]] } #' @export `$<-.rlang_data_pronoun` <- function(x, i, value) { dict <- unclass_data_pronoun(x) if (dict$read_only) { abort("Can't modify the data pronoun") } dict$src[[i]] <- value set_attrs(dict, class = class(x)) } #' @export `[[<-.rlang_data_pronoun` <- function(x, i, value) { dict <- unclass_data_pronoun(x) if (dict$read_only) { abort("Can't modify the data pronoun") } if (!is_string(i)) { abort("Must subset the data pronoun with a string") } dict$src[[i]] <- value set_attrs(dict, class = class(x)) } #' @export names.rlang_data_pronoun <- function(x) { names(unclass(x)$src) } #' @export length.rlang_data_pronoun <- function(x) { length(unclass(x)$src) } has_binding <- function(x, name) { if (is_environment(x)) { env_has(x, name) } else { has_name(x, name) } } #' @export print.rlang_data_pronoun <- function(x, ...) { src <- unclass_data_pronoun(x)$src objs <- glue_countable(length(src), "object") cat(paste0("\n", objs, "\n")) invisible(x) } #' @importFrom utils str #' @export str.rlang_data_pronoun <- function(object, ...) { str(unclass_data_pronoun(object)$src, ...) } glue_countable <- function(n, str) { if (n == 1) { paste0(n, " ", str) } else { paste0(n, " ", str, "s") } } # Unclassing before print() or str() is necessary because default # methods index objects with integers unclass_data_pronoun <- function(x) { i <- match("rlang_data_pronoun", class(x)) class(x) <- class(x)[-i] x } rlang/R/formula.R0000644000176200001440000001165213241233650013352 0ustar liggesusers#' Create a formula #' #' @param lhs,rhs A call, name, or atomic vector. #' @param env An environment. #' @return A formula object. #' @seealso [new_quosure()] #' @export #' @examples #' new_formula(quote(a), quote(b)) #' new_formula(NULL, quote(b)) new_formula <- function(lhs, rhs, env = caller_env()) { .Call(rlang_new_formula, lhs, rhs, env) } #' Is object a formula? #' #' `is_formula()` tests if `x` is a call to `~`. `is_bare_formula()` #' tests in addition that `x` does not inherit from anything else than #' `"formula"`. #' #' The `scoped` argument patterns-match on whether the scoped bundled #' with the quosure is valid or not. Invalid scopes may happen in #' nested quotations like `~~expr`, where the outer quosure is validly #' scoped but not the inner one. This is because `~` saves the #' environment when it is evaluated, and quoted formulas are by #' definition not evaluated. #' #' @param x An object to test. #' @param scoped A boolean indicating whether the quosure is scoped, #' that is, has a valid environment attribute. If `NULL`, the scope #' is not inspected. #' @param lhs A boolean indicating whether the [formula][is_formula] #' or [definition][is_definition] has a left-hand side. If `NULL`, #' the LHS is not inspected. #' @export #' @examples #' x <- disp ~ am #' is_formula(x) #' #' is_formula(~10) #' is_formula(10) #' #' is_formula(quo(foo)) #' is_bare_formula(quo(foo)) #' #' # Note that unevaluated formulas are treated as bare formulas even #' # though they don't inherit from "formula": #' f <- quote(~foo) #' is_bare_formula(f) #' #' # However you can specify `scoped` if you need the predicate to #' # return FALSE for these unevaluated formulas: #' is_bare_formula(f, scoped = TRUE) #' is_bare_formula(eval(f), scoped = TRUE) is_formula <- function(x, scoped = NULL, lhs = NULL) { if (!is_formulaish(x, scoped = scoped, lhs = lhs)) { return(FALSE) } identical(node_car(x), tilde_sym) } #' @rdname is_formula #' @export is_bare_formula <- function(x, scoped = NULL, lhs = NULL) { if (!is_formula(x, scoped = scoped, lhs = lhs)) { return(FALSE) } class <- class(x) is_null(class) || identical(class, "formula") } #' Get or set formula components #' #' `f_rhs` extracts the righthand side, `f_lhs` extracts the lefthand #' side, and `f_env` extracts the environment. All functions throw an #' error if `f` is not a formula. #' #' @param f,x A formula #' @param value The value to replace with. #' @export #' @return `f_rhs` and `f_lhs` return language objects (i.e. atomic #' vectors of length 1, a name, or a call). `f_env` returns an #' environment. #' @examples #' f_rhs(~ 1 + 2 + 3) #' f_rhs(~ x) #' f_rhs(~ "A") #' f_rhs(1 ~ 2) #' #' f_lhs(~ y) #' f_lhs(x ~ y) #' #' f_env(~ x) f_rhs <- function(f) { if (is_quosure(f)) { signal_formula_access() return(quo_get_expr(f)) } .Call(r_f_rhs, f) } #' @export #' @rdname f_rhs `f_rhs<-` <- function(x, value) { if (is_quosure(x)) { signal_formula_access() return(quo_set_expr(x, value)) } if (!is_formula(x)) { abort("`f` must be a formula") } x[[length(x)]] <- value x } #' @export #' @rdname f_rhs f_lhs <- function(f) { if (is_quosure(f)) { signal_formula_access() abort("Can't retrieve the LHS of a quosure") } .Call(r_f_lhs, f) } #' @export #' @rdname f_rhs `f_lhs<-` <- function(x, value) { if (is_quosure(x)) { signal_formula_access() abort("Can't set the LHS of a quosure") } if (!is_formula(x)) { abort("`f` must be a formula") } if (length(x) < 3) { x <- duplicate(x) node_poke_cdr(x, pairlist(value, x[[2]])) } else { x[[2]] <- value } x } #' @export #' @rdname f_rhs f_env <- function(f) { if (is_quosure(f)) { signal_formula_access() return(quo_get_env(f)) } if (!is_formula(f)) { abort("`f` must be a formula") } attr(f, ".Environment") } #' @export #' @rdname f_rhs `f_env<-` <- function(x, value) { if (is_quosure(x)) { signal_formula_access() return(quo_set_env(x, value)) } if (!is_formula(x)) { abort("`f` must be a formula") } set_attrs(x, .Environment = value) } #' Turn RHS of formula into a string or label #' #' Equivalent of [expr_text()] and [expr_label()] for formulas. #' #' @param x A formula. #' @inheritParams expr_text #' @export #' @examples #' f <- ~ a + b + bc #' f_text(f) #' f_label(f) #' #' # Names a quoted with `` #' f_label(~ x) #' # Strings are encoded #' f_label(~ "a\nb") #' # Long expressions are collapsed #' f_label(~ foo({ #' 1 + 2 #' print(x) #' })) f_text <- function(x, width = 60L, nlines = Inf) { expr_text(f_rhs(x), width = width, nlines = nlines) } #' @rdname f_text #' @export f_name <- function(x) { expr_name(f_rhs(x)) } #' @rdname f_text #' @export f_label <- function(x) { expr_label(f_rhs(x)) } signal_formula_access <- function() { if (is_true(peek_option("rlang_internal_warn_quosure_access"))) { warn( "Using formula accessors with quosures is soft-deprecated" ) } } rlang/R/arg.R0000644000176200001440000001407413241233650012457 0ustar liggesusers#' Match an argument to a character vector #' #' @description #' #' This is equivalent to [base::match.arg()] with a few differences: #' #' * Partial matches trigger an error. #' #' * Error messages are a bit more informative and obey the tidyverse #' standards. #' #' @param arg A symbol referring to an argument accepting strings. #' @param values The possible values that `arg` can take. If `NULL`, #' the values are taken from the function definition of the [caller #' frame][caller_frame]. #' @return The string supplied to `arg`. #' @export #' @examples #' fn <- function(x = c("foo", "bar")) arg_match(x) #' fn("bar") #' #' # This would throw an informative error if run: #' # fn("b") #' # fn("baz") arg_match <- function(arg, values = NULL) { arg_expr <- enexpr(arg) if (!is_symbol(arg_expr)) { abort("Internal error: `arg_match()` expects a symbol") } arg_nm <- as_string(arg_expr) if (is_null(values)) { fn <- caller_fn() values <- fn_fmls(fn)[[arg_nm]] values <- eval_bare(values, get_env(fn)) } if (!is_character(values)) { abort("Internal error: `values` must be a character vector") } if (!is_character(arg)) { abort(paste0(chr_quoted(arg_nm), " must be a character vector")) } arg <- arg[[1]] i <- match(arg, values) if (is_na(i)) { msg <- paste0(chr_quoted(arg_nm), " should be one of: ") msg <- paste0(msg, chr_enumerate(chr_quoted(values, "\""))) i_partial <- pmatch(arg, values) if (!is_na(i_partial)) { candidate <- values[[i_partial]] candidate <- chr_quoted(candidate, "\"") msg <- paste0(msg, "\n", "Did you mean ", candidate, "?") } abort(msg) } values[[i]] } chr_quoted <- function(chr, type = "`") { paste0(type, chr, type) } chr_enumerate <- function(chr, sep = ", ", final = "or") { if (length(chr) < 2) { return(chr) } n <- length(chr) head <- chr[seq_len(n - 1)] last <- chr[length(chr)] head <- paste(head, collapse = ", ") paste(head, final, last) } #' Generate or handle a missing argument #' #' @description #' #' These functions help using the missing argument as a regular R #' object. #' #' * `missing_arg()` generates a missing argument. #' #' * `is_missing()` is like [base::missing()] but also supports #' testing for missing arguments contained in other objects like #' lists. #' #' * `maybe_missing()` is useful to pass down an input that might be #' missing to another function. It avoids triggering an #' "argument is missing" error. #' #' #' @section Other ways to reify the missing argument: #' #' * `base::quote(expr = )` is the canonical way to create a missing #' argument object. #' #' * `expr()` called without argument creates a missing argument. #' #' * `quo()` called without argument creates an empty quosure, i.e. a #' quosure containing the missing argument object. #' #' #' @section Fragility of the missing argument object: #' #' The missing argument is an object that triggers an error if and #' only if it is the result of evaluating a symbol. No error is #' produced when a function call evaluates to the missing argument #' object. This means that expressions like `x[[1]] <- missing_arg()` #' are perfectly safe. Likewise, `x[[1]]` is safe even if the result #' is the missing object. #' #' However, as soon as the missing argument is passed down between #' functions through an argument, you're at risk of triggering a #' missing error. This is because arguments are passed through #' symbols. To work around this, `is_missing()` and `maybe_missing(x)` #' use a bit of magic to determine if the input is the missing #' argument without triggering a missing error. #' #' `maybe_missing()` is particularly useful for prototyping #' meta-programming algorithm in R. The missing argument is a likely #' input when computing on the language because it is a standard #' object in formals lists. While C functions are always allowed to #' return the missing argument and pass it to other C functions, this #' is not the case on the R side. If you're implementing your #' meta-programming algorithm in R, use `maybe_missing()` when an #' input might be the missing argument object. #' #' #' @section Life cycle: #' #' * `missing_arg()` and `is_missing()` are stable. #' * Like the rest of rlang, `maybe_missing()` is maturing. #' #' @param x An object that might be the missing argument. #' @export #' @examples #' # The missing argument usually arises inside a function when the #' # user omits an argument that does not have a default: #' fn <- function(x) is_missing(x) #' fn() #' #' # Creating a missing argument can also be useful to generate calls #' args <- list(1, missing_arg(), 3, missing_arg()) #' quo(fn(!!! args)) #' #' # Other ways to create that object include: #' quote(expr = ) #' expr() #' #' # It is perfectly valid to generate and assign the missing #' # argument in a list. #' x <- missing_arg() #' l <- list(missing_arg()) #' #' # Just don't evaluate a symbol that contains the empty argument. #' # Evaluating the object `x` that we created above would trigger an #' # error. #' # x # Not run #' #' # On the other hand accessing a missing argument contained in a #' # list does not trigger an error because subsetting is a function #' # call: #' l[[1]] #' is.null(l[[1]]) #' #' # In case you really need to access a symbol that might contain the #' # empty argument object, use maybe_missing(): #' maybe_missing(x) #' is.null(maybe_missing(x)) #' is_missing(maybe_missing(x)) #' #' #' # Note that base::missing() only works on symbols and does not #' # support complex expressions. For this reason the following lines #' # would throw an error: #' #' #> missing(missing_arg()) #' #> missing(l[[1]]) #' #' # while is_missing() will work as expected: #' is_missing(missing_arg()) #' is_missing(l[[1]]) missing_arg <- function() { .Call(rlang_missing_arg) } #' @rdname missing_arg #' @export is_missing <- function(x) { expr <- substitute(x) if (typeof(expr) == "symbol" && missing(x)) { TRUE } else { identical(x, missing_arg()) } } #' @rdname missing_arg #' @export maybe_missing <- function(x) { if (is_missing(x)) { missing_arg() } else { x } } rlang/R/sym.R0000644000176200001440000000271313241233650012513 0ustar liggesusers#' Create a symbol or list of symbols #' #' These functions take strings as input and turn them into symbols. #' Contrarily to `as.name()`, they convert the strings to the native #' encoding beforehand. This is necessary because symbols remove #' silently the encoding mark of strings (see [set_str_encoding()]). #' #' @param x A string or list of strings. #' @return A symbol for `sym()` and a list of symbols for `syms()`. #' @export #' @examples #' # The empty string returns the missing argument: #' sym("") #' #' # This way sym() and as_string() are inverse of each other: #' as_string(missing_arg()) #' sym(as_string(missing_arg())) sym <- function(x) { if (is_symbol(x)) { return(x) } if (identical(x, "")) { return(missing_arg()) } if (!is_string(x)) { abort("Only strings can be converted to symbols") } .Call(rlang_symbol, x) } #' @rdname sym #' @export syms <- function(x) { map(x, sym) } #' Is object a symbol? #' @param x An object to test. #' @param name An optional name that the symbol should match. #' @export is_symbol <- function(x, name = NULL) { if (typeof(x) != "symbol") { return(FALSE) } if (!is_null(name) && !identical(as_string(x), name)) { return(FALSE) } TRUE } namespace_sym <- quote(`::`) namespace2_sym <- quote(`:::`) dollar_sym <- quote(`$`) at_sym <- quote(`@`) tilde_sym <- quote(`~`) colon_equals_sym <- quote(`:=`) brace_sym <- quote(`{`) dots_sym <- quote(...) function_sym <- quote(`function`) rlang/R/vec-squash.R0000644000176200001440000000740113241233650013761 0ustar liggesusers#' Flatten or squash a list of lists into a simpler vector #' #' `flatten()` removes one level hierarchy from a list, while #' `squash()` removes all levels. These functions are similar to #' [unlist()] but they are type-stable so you always know what the #' type of the output is. #' #' @param x A list of flatten or squash. The contents of the list can #' be anything for unsuffixed functions `flatten()` and `squash()` #' (as a list is returned), but the contents must match the type for #' the other functions. #' @return `flatten()` returns a list, `flatten_lgl()` a logical #' vector, `flatten_int()` an integer vector, `flatten_dbl()` a #' double vector, and `flatten_chr()` a character vector. Similarly #' for `squash()` and the typed variants (`squash_lgl()` etc). #' @export #' @examples #' x <- replicate(2, sample(4), simplify = FALSE) #' x #' #' flatten(x) #' flatten_int(x) #' #' # With flatten(), only one level gets removed at a time: #' deep <- list(1, list(2, list(3))) #' flatten(deep) #' flatten(flatten(deep)) #' #' # But squash() removes all levels: #' squash(deep) #' squash_dbl(deep) #' #' # The typed flattens remove one level and coerce to an atomic #' # vector at the same time: #' flatten_dbl(list(1, list(2))) #' #' # Only bare lists are flattened, but you can splice S3 lists #' # explicitly: #' foo <- set_attrs(list("bar"), class = "foo") #' str(flatten(list(1, foo, list(100)))) #' str(flatten(list(1, splice(foo), list(100)))) #' #' # Instead of splicing manually, flatten_if() and squash_if() let #' # you specify a predicate function: #' is_foo <- function(x) inherits(x, "foo") || is_bare_list(x) #' str(flatten_if(list(1, foo, list(100)), is_foo)) #' #' # squash_if() does the same with deep lists: #' deep_foo <- list(1, list(foo, list(foo, 100))) #' str(deep_foo) #' #' str(squash(deep_foo)) #' str(squash_if(deep_foo, is_foo)) flatten <- function(x) { .Call(rlang_squash, x, "list", is_spliced_bare, 1L) } #' @rdname flatten #' @export flatten_lgl <- function(x) { .Call(rlang_squash, x, "logical", is_spliced_bare, 1L) } #' @rdname flatten #' @export flatten_int <- function(x) { .Call(rlang_squash, x, "integer", is_spliced_bare, 1L) } #' @rdname flatten #' @export flatten_dbl <- function(x) { .Call(rlang_squash, x, "double", is_spliced_bare, 1L) } #' @rdname flatten #' @export flatten_cpl <- function(x) { .Call(rlang_squash, x, "complex", is_spliced_bare, 1L) } #' @rdname flatten #' @export flatten_chr <- function(x) { .Call(rlang_squash, x, "character", is_spliced_bare, 1L) } #' @rdname flatten #' @export flatten_raw <- function(x) { .Call(rlang_squash, x, "raw", is_spliced_bare, 1L) } #' @rdname flatten #' @export squash <- function(x) { .Call(rlang_squash, x, "list", is_spliced_bare, -1L) } #' @rdname flatten #' @export squash_lgl <- function(x) { .Call(rlang_squash, x, "logical", is_spliced_bare, -1L) } #' @rdname flatten #' @export squash_int <- function(x) { .Call(rlang_squash, x, "integer", is_spliced_bare, -1L) } #' @rdname flatten #' @export squash_dbl <- function(x) { .Call(rlang_squash, x, "double", is_spliced_bare, -1L) } #' @rdname flatten #' @export squash_cpl <- function(x) { .Call(rlang_squash, x, "complex", is_spliced_bare, -1L) } #' @rdname flatten #' @export squash_chr <- function(x) { .Call(rlang_squash, x, "character", is_spliced_bare, -1L) } #' @rdname flatten #' @export squash_raw <- function(x) { .Call(rlang_squash, x, "raw", is_spliced_bare, -1L) } #' @rdname flatten #' @param predicate A function of one argument returning whether it #' should be spliced. #' @export flatten_if <- function(x, predicate = is_spliced) { .Call(rlang_squash, x, "list", predicate, 1L) } #' @rdname flatten #' @export squash_if <- function(x, predicate = is_spliced) { .Call(rlang_squash, x, "list", predicate, -1L) } rlang/R/node.R0000644000176200001440000001201113241233650012620 0ustar liggesusers#' Helpers for pairlist and language nodes #' #' @description #' #' **Important**: These functions are for expert R programmers only. #' You should only use them if you feel comfortable manipulating low #' level R data structures at the C level. We export them at R level #' in order to make it easy to prototype C code. They don't perform #' any type checking and can crash R very easily (try to take the CAR #' of an integer vector --- save any important object beforehand!). #' #' @param x A language or pairlist node. Note that these functions are #' barebones and do not perform any type checking. #' @param car,newcar,cdr,newcdr The new CAR or CDR for the node. These #' can be any R objects. #' @param newtag The new tag for the node. This should be a symbol. #' @return Setters like `node_poke_car()` invisibly return `x` modified #' in place. Getters return the requested node component. #' @seealso [duplicate()] for creating copy-safe objects and #' [base::pairlist()] for an easier way of creating a linked list of #' nodes. #' @keywords internal #' @export new_node <- function(car, cdr = NULL) { .Call(rlang_new_node, car, cdr) } #' @rdname new_node #' @export node_car <- function(x) { .Call(rlang_node_car, x) } #' @rdname new_node #' @export node_cdr <- function(x) { .Call(rlang_node_cdr, x) } #' @rdname new_node #' @export node_caar <- function(x) { .Call(rlang_node_caar, x) } #' @rdname new_node #' @export node_cadr <- function(x) { .Call(rlang_node_cadr, x) } #' @rdname new_node #' @export node_cdar <- function(x) { .Call(rlang_node_cdar, x) } #' @rdname new_node #' @export node_cddr <- function(x) { .Call(rlang_node_cddr, x) } #' @rdname new_node #' @export node_poke_car <- function(x, newcar) { invisible(.Call(rlang_node_poke_car, x, newcar)) } #' @rdname new_node #' @export node_poke_cdr <- function(x, newcdr) { invisible(.Call(rlang_node_poke_cdr, x, newcdr)) } #' @rdname new_node #' @export node_poke_caar <- function(x, newcar) { invisible(.Call(rlang_node_poke_caar, x, newcar)) } #' @rdname new_node #' @export node_poke_cadr <- function(x, newcar) { invisible(.Call(rlang_node_poke_cadr, x, newcar)) } #' @rdname new_node #' @export node_poke_cdar <- function(x, newcdr) { invisible(.Call(rlang_node_poke_cdar, x, newcdr)) } #' @rdname new_node #' @export node_poke_cddr <- function(x, newcdr) { invisible(.Call(rlang_node_poke_cddr, x, newcdr)) } #' @rdname new_node #' @export node_tag <- function(x) { .Call(rlang_node_tag, x) } #' @rdname new_node #' @export node_poke_tag <- function(x, newtag) { invisible(.Call(rlang_node_poke_tag, x, newtag)) } #' Coerce to pairlist #' #' This transforms vector objects to a linked pairlist of nodes. See #' the [pairlist][node] type help page. #' #' #' @keywords internal #' @section Life cycle: #' #' `as_pairlist()` is experimental because we are still figuring out #' the naming scheme for pairlists and node-like objects. #' #' @param x An object to coerce. #' @export as_pairlist <- function(x) { if (! typeof(x) %in% c(atomic_types, "list", "pairlist", "NULL")) { abort_coercion(x, "pairlist") } as.vector(x, "pairlist") } #' Is object a node or pairlist? #' #' @description #' #' * `is_pairlist()` checks that `x` has type `pairlist`. #' #' * `is_node()` checks that `x` has type `pairlist` or `language`. #' It tests whether `x` is a node that has a CAR and a CDR, #' including callable nodes (language objects). #' #' * `is_node_list()` checks that `x` has type `pairlist` or `NULL`. #' `NULL` is the empty node list. #' #' #' @section Life cycle: #' #' These functions are experimental. We are still figuring out a good #' naming convention to refer to the different lisp-like lists in R. #' #' @param x Object to test. #' @seealso [is_call()] tests for language nodes. #' @keywords internal #' @export is_pairlist <- function(x) { typeof(x) == "pairlist" } #' @rdname is_pairlist #' @export is_node <- function(x) { typeof(x) %in% c("pairlist", "language") } #' @rdname is_pairlist #' @export is_node_list <- function(x) { typeof(x) %in% c("pairlist", "NULL") } # Shallow copy of node trees node_tree_clone <- function(x) { .Call(rlang_node_tree_clone, x); } node_walk <- function(.x, .f, ...) { cur <- .x while (!is.null(cur)) { .f(cur, ...) cur <- node_cdr(cur) } NULL } node_walk_nonnull <- function(.x, .f, ...) { cur <- .x out <- NULL while (!is.null(cur) && is.null(out)) { out <- .f(cur, ...) cur <- node_cdr(cur) } out } node_walk_last <- function(.x, .f, ...) { cur <- .x while (!is.null(node_cdr(cur))) { cur <- node_cdr(cur) } .f(cur, ...) } node_append <- function(.x, .y) { node_walk_last(.x, function(l) node_poke_cdr(l, .y)) .x } #' Create a new call from components #' #' @param car The head of the call. It should be a #' [callable][is_callable] object: a symbol, call, or literal #' function. #' @param cdr The tail of the call, i.e. a [node list][node] of #' arguments. #' #' @keywords internal #' @export new_call <- function(car, cdr = NULL) { .Call(rlang_new_call, car, cdr) } rlang/R/quo.R0000644000176200001440000003055413241233650012513 0ustar liggesusers#' Quosure getters, setters and testers #' #' @description #' #' You can access the quosure components (its expression and its #' environment) with: #' #' * [get_expr()] and [get_env()]. These getters also support other #' kinds of objects such as formulas #' #' * `quo_get_expr()` and `quo_get_env()`. These getters only work #' with quosures and throw an error with other types of input. #' #' Test if an object is a quosure with `is_quosure()`. If you know an #' object is a quosure, use the `quo_` prefixed predicates to check #' its contents, `quo_is_missing()`, `quo_is_symbol()`, etc. #' #' #' @section Empty quosures: #' #' When missing arguments are captured as quosures, either through #' [enquo()] or [quos()], they are returned as an empty quosure. These #' quosures contain the [missing argument][missing_arg] and typically #' have the [empty environment][empty_env] as enclosure. #' #' #' @section Life cycle: #' #' - `is_quosure()` is stable. #' #' - `quo_get_expr()` and `quo_get_env()` are stable. #' #' - `is_quosureish()` is deprecated as of rlang 0.2.0. This function #' assumed that quosures are formulas which is currently true but #' might not be in the future. #' #' #' @name quosure #' @seealso [quo()] for creating quosures by quotation; [as_quosure()] #' and [new_quosure()] for constructing quosures manually. #' @examples #' quo <- quo(my_quosure) #' quo #' #' #' # Access and set the components of a quosure: #' quo_get_expr(quo) #' quo_get_env(quo) #' #' quo <- quo_set_expr(quo, quote(baz)) #' quo <- quo_set_env(quo, empty_env()) #' quo #' #' # Test wether an object is a quosure: #' is_quosure(quo) #' #' # If it is a quosure, you can use the specialised type predicates #' # to check what is inside it: #' quo_is_symbol(quo) #' quo_is_call(quo) #' quo_is_null(quo) #' #' # quo_is_missing() checks for a special kind of quosure, the one #' # that contains the missing argument: #' quo() #' quo_is_missing(quo()) #' #' fn <- function(arg) enquo(arg) #' fn() #' quo_is_missing(fn()) NULL #' @rdname quosure #' @param x An object to test. #' @export is_quosure <- function(x) { inherits(x, "quosure") } #' @rdname quosure #' @param quo A quosure to test. #' @export quo_is_missing <- function(quo) { .Call(rlang_quo_is_missing, quo) } #' @rdname quosure #' @param name The name of the symbol or function call. If `NULL` the #' name is not tested. #' @export quo_is_symbol <- function(quo, name = NULL) { is_symbol(quo_get_expr(quo), name = name) } #' @rdname quosure #' @inheritParams is_call #' @export quo_is_call <- function(quo, name = NULL, n = NULL, ns = NULL) { is_call(quo_get_expr(quo), name = name, n = n, ns = ns) } #' @rdname quosure #' @export quo_is_symbolic <- function(quo) { .Call(rlang_quo_is_symbolic, quo) } #' @rdname quosure #' @export quo_is_null <- function(quo) { .Call(rlang_quo_is_null, quo) } #' @rdname quosure #' @export quo_get_expr <- function(quo) { .Call(rlang_quo_get_expr, quo) } #' @rdname quosure #' @export quo_get_env <- function(quo) { .Call(rlang_quo_get_env, quo) } #' @rdname quosure #' @param expr A new expression for the quosure. #' @export quo_set_expr <- function(quo, expr) { .Call(rlang_quo_set_expr, quo, expr) } #' @rdname quosure #' @param env A new environment for the quosure. #' @export quo_set_env <- function(quo, env) { .Call(rlang_quo_set_env, quo, env) } #' @rdname quosure #' @export is_quosures <- function(x) { inherits(x, "quosures") } #' @export `[.quosures` <- function(x, i) { set_attrs(NextMethod(), class = "quosures") } #' @export c.quosures <- function(..., recursive = FALSE) { structure(NextMethod(), class = "quosures") } #' @export print.quosures <- function(x, ...) { print(unclass(x), ...) } #' Coerce object to quosure #' #' @description #' #' While `new_quosure()` wraps any R object (including expressions, #' formulas, or other quosures) into a quosure, `as_quosure()` #' converts formulas and quosures and does not double-wrap. #' #' #' @section Life cycle: #' #' - Like the rest of the rlang package, `new_quosure()` and #' `as_quosure()` are maturing. #' #' - `as_quosureish()` is deprecated as of rlang 0.2.0. This function #' assumes that quosures are formulas which is currently true but #' might not be in the future. #' #' @param x An object to convert. Either an [expression][is_expression] or a #' formula. #' @param env The original context of the context expression. #' @seealso [quo()], [is_quosure()] #' @export #' @examples #' # as_quosure() converts expressions or any R object to a validly #' # scoped quosure: #' as_quosure(quote(expr), base_env()) #' as_quosure(10L, base_env()) #' #' #' # Sometimes you get unscoped formulas because of quotation: #' f <- ~~expr #' inner_f <- f_rhs(f) #' str(inner_f) #' #' # In that case testing for a scoped formula returns FALSE: #' is_formula(inner_f, scoped = TRUE) #' #' # With as_quosure() you ensure that this kind of unscoped formulas #' # will be granted a default environment: #' as_quosure(inner_f, base_env()) as_quosure <- function(x, env = caller_env()) { if (is_quosure(x)) { x } else if (is_bare_formula(x)) { new_quosure(f_rhs(x), f_env(x) %||% env) } else if (is_symbolic(x)) { new_quosure(x, env) } else { new_quosure(x, empty_env()) } } #' @rdname as_quosure #' @param expr The expression wrapped by the quosure. #' @export new_quosure <- function(expr, env = caller_env()) { .Call(rlang_new_quosure, expr, env) } #' Squash a quosure #' #' @description #' #' `quo_squash()` flattens all nested quosures within an expression. #' For example it transforms `^foo(^bar(), ^baz)` to the bare #' expression `foo(bar(), baz)`. #' #' This operation is safe if the squashed quosure is used for #' labelling or printing (see [quo_label()] or [quo_name()]). However #' if the squashed quosure is evaluated, all expressions of the #' flattened quosures are resolved in a single environment. This is a #' source of bugs so it is good practice to set `warn` to `TRUE` to #' let the user know about the lossy squashing. #' #' #' @section Life cycle: #' #' This function replaces `quo_expr()` which was soft-deprecated in #' rlang 0.2.0. `quo_expr()` was a misnomer because it implied that it #' was a mere expression acccessor for quosures whereas it was really #' a lossy operation that squashed all nested quosures. #' #' #' @param quo A quosure or expression. #' @param warn Whether to warn if the quosure contains other quosures #' (those will be collapsed). This is useful when you use #' `quo_squash()` in order to make a non-tidyeval API compatible #' with quosures. In that case, getting rid of the nested quosures #' is likely to cause subtle bugs and it is good practice to warn #' the user about it. #' #' @export #' @examples #' # Quosures can contain nested quosures: #' quo <- quo(wrapper(!!quo(wrappee))) #' quo #' #' # quo_squash() flattens all the quosures and returns a simple expression: #' quo_squash(quo) quo_squash <- function(quo, warn = FALSE) { # Never warn when unwrapping outer quosure if (is_quosure(quo)) { quo <- quo_get_expr(quo) } if (is_missing(quo)) { missing_arg() } else { quo_squash_impl(duplicate(quo), warn = warn) } } #' Format quosures for printing or labelling #' #' @description #' #' * `quo_text()` and `quo_label()` are equivalent to [expr_text()], #' [expr_label()], etc, but they first squash all quosures with #' [quo_squash()] so they print more nicely. #' #' * `quo_name()` squashes a quosure and transforms it into a simple #' string. It is suitable to give an unnamed quosure a default name, #' for instance a column name in a data frame. #' #' @inheritParams quo_squash #' @inheritParams expr_label #' @export #' @seealso [expr_label()], [f_label()] #' @examples #' # Quosures can contain nested quosures: #' quo <- quo(foo(!! quo(bar))) #' quo #' #' # quo_squash() unwraps all quosures and returns a raw expression: #' quo_squash(quo) #' #' # This is used by quo_text() and quo_label(): #' quo_text(quo) #' #' # Compare to the unwrapped expression: #' expr_text(quo) #' #' # quo_name() is helpful when you need really short labels: #' quo_name(quo(sym)) #' quo_name(quo(!! sym)) quo_label <- function(quo) { expr_label(quo_squash(quo)) } #' @rdname quo_label #' @export quo_text <- function(quo, width = 60L, nlines = Inf) { expr_text(quo_squash(quo), width = width, nlines = nlines) } #' @rdname quo_label #' @export quo_name <- function(quo) { expr_name(quo_squash(quo)) } quo_squash_impl <- function(x, parent = NULL, warn = FALSE) { switch_expr(x, language = { if (is_quosure(x)) { if (!is_false(warn)) { if (is_string(warn)) { msg <- warn } else { msg <- "Collapsing inner quosure" } warn(msg) warn <- FALSE } while (is_quosure(x)) { x <- quo_get_expr(x) } if (!is_null(parent)) { node_poke_car(parent, x) } quo_squash_impl(x, parent, warn = warn) } else { quo_squash_impl(node_cdr(x), warn = warn) } }, pairlist = { while (!is_null(x)) { quo_squash_impl(node_car(x), x, warn = warn) x <- node_cdr(x) } } ) x } #' @export print.quosure <- function(x, ...) { meow(.trailing = FALSE, "", " expr: " ) quo_print(x) meow(.trailing = FALSE, " env: " ) env <- get_env(x) quo_env_print(env) invisible(x) } #' @export str.quosure <- function(object, ...) { str(unclass(object), ...) } # Create a circular list of colours. This infloops if printed in the REPL! new_quo_palette <- function() { last_node <- new_node(open_cyan, NULL) palette <- new_node(open_blue, new_node(open_green, new_node(open_magenta, last_node))) node_poke_cdr(last_node, palette) # First node has no colour new_node(close_colour, palette) } # Reproduces output of printed calls base_deparse <- function(x) { deparse(x, control = "keepInteger") } quo_deparse <- function(x, lines = new_quo_deparser()) { if (!is_quosure(x)) { return(sexp_deparse(x, lines = lines)) } env <- quo_get_env(x) lines$quo_open_colour(env) lines$push("^") lines$make_next_sticky() sexp_deparse(quo_get_expr(x), lines) lines$quo_reset_colour() lines$get_lines() } new_quo_deparser <- function(width = peek_option("width"), crayon = has_crayon()) { lines <- new_lines(width = width, deparser = quo_deparse) child_r6lite(lines, has_colour = crayon, quo_envs = list(), quo_history = pairlist(), quo_colours = list( open_blue, open_green, open_magenta, open_cyan, open_yellow ), quo_was_too_many = FALSE, quo_push_opener = function(self, opener) { self$quo_history <- new_node(opener, self$quo_history) self$push_sticky(opener()) self }, quo_open_colour = function(self, env) { if (self$has_colour) { if (is_reference(env, global_env()) || is_reference(env, empty_env())) { self$quo_push_opener(close_colour) return(NULL) } n_known_envs <- length(self$quo_envs) idx <- detect_index(self$quo_envs, identical, env) if (idx) { opener <- self$quo_colours[[idx]] } else if (n_known_envs < length(self$quo_colours)) { self$quo_envs <- c(self$quo_envs, list(env)) idx <- n_known_envs + 1L opener <- self$quo_colours[[idx]] } else { opener <- function() paste0(close_colour(), open_blurred_italic()) self$quo_was_too_many <- TRUE } self$quo_push_opener(opener) } }, quo_reset_colour = function(self) { if (self$has_colour) { if (self$quo_was_too_many) { self$push_sticky(close_blurred_italic()) } self$quo_history <- node_cdr(self$quo_history) reset <- node_car(self$quo_history) %||% close_colour self$push_sticky(reset()) } } ) } quo_print <- function(quo) { # Take into account the first 8-character wide columns width <- peek_option("width") - 10L deparser <- new_quo_deparser(width = width) lines <- quo_deparse(quo, deparser) n <- length(lines) lines[seq2(2, n)] <- paste0(" ", lines[seq2(2, n)]) cat(paste0(lines, "\n")) } quo_env_print <- function(env) { if (is_reference(env, global_env())) { nm <- "global" } else if (is_reference(env, empty_env())) { nm <- "empty" } else { nm <- blue(sxp_address(env)) } meow(nm) } rlang/R/deparse.R0000644000176200001440000003246313241233650013333 0ustar liggesusers line_push <- function(line, text, sticky = FALSE, boundary = NULL, width = NULL, indent = 0L, has_colour = FALSE) { if (!length(line)) { return(text) } if (!is_string(line)) { abort("`line` must be a string or empty") } if (!is_string(text)) { abort("`text` must be a string") } width <- width %||% peek_option("width") if (!has_overflown(line, text, width, has_colour)) { return(paste0(line, text)) } if (is_scalar_integer(boundary) && nchar(line) != boundary) { first <- substr(line, 0L, boundary) second <- substr(line, boundary + 1L, nchar(line)) # Trim trailing spaces after boundary second <- trim_leading_spaces(second) second <- paste0(spaces(indent), second) if (sticky || !has_overflown(second, text, width, has_colour)) { line <- trim_trailing_spaces(first) text <- paste0(second, text) } else { text <- paste0(spaces(indent), text) } } else if (sticky) { line <- paste0(line, text) text <- chr() } else { line <- trim_trailing_spaces(line) text <- paste0(spaces(indent), text) } c(line, text) } spaces <- function(n) { paste(rep(" ", n), collapse = "") } is_spaces <- function(str) { identical(str, spaces(nchar(str))) } has_overflown <- function(line, text, width, has_colour) { if (has_colour) { line <- strip_style(line) text <- strip_style(text) } text <- trim_trailing_spaces(text) nchar(line) + nchar(text) > width && !is_spaces(line) } trim_trailing_spaces <- function(line) { sub(" *$", "", line) } trim_leading_spaces <- function(line) { sub("^ *", "", line) } new_lines <- function(width = peek_option("width"), deparser = sexp_deparse) { width <- width %||% 60L r6lite( deparse = function(self, x) { deparser(x, lines = self) }, width = width, boundary = NULL, next_sticky = FALSE, indent = 0L, indent_status = pairlist(), next_indent_sticky = FALSE, has_colour = FALSE, lines = chr(), last_line = chr(), get_lines = function(self) { c(self$lines, self$last_line) }, get_indent = function(self) { if (self$indent < 0) { warn("Internal error: Negative indent while deparsing") 0L } else { self$indent } }, push = function(self, lines) { stopifnot(is_character(lines)) for (line in lines) { self$push_one(line) } self }, push_one = function(self, line) { line <- line_push(self$last_line, line, sticky = self$next_sticky, boundary = self$boundary, width = self$width, indent = self$get_indent(), has_colour = self$has_colour ) n <- length(line) if (n > 1) { self$lines <- c(self$lines, line[-n]) self$last_line <- line[[n]] self$boundary <- NULL self$next_indent_sticky <- FALSE } else if (n) { self$last_line <- line if (self$next_sticky) { self$boundary <- nchar(line) } } self$next_sticky <- FALSE self }, push_newline = function(self) { self$lines <- c(self$lines, self$last_line) self$last_line <- spaces(self$get_indent()) self$next_sticky <- FALSE self$next_indent_sticky <- FALSE self }, push_sticky = function(self, line) { stopifnot(is_string(line)) self$next_sticky <- TRUE self$push(line) self$set_boundary() self }, make_next_sticky = function(self) { self$next_sticky <- TRUE self }, set_boundary = function(self) { self$boundary <- nchar(self$last_line) self }, increase_indent = function(self) { status <- node_car(self$indent_status) if (self$next_indent_sticky) { node_poke_cdr(status, inc(node_cdr(status))) } else { self$indent <- self$indent + 2L self$indent_status <- new_node(new_node(FALSE, 0L), self$indent_status) self$next_indent_sticky <- TRUE } self }, decrease_indent = function(self) { status <- node_car(self$indent_status) if (is_null(status)) { warn("Internal error: Detected NULL `status` while deparsing") return(self) } reset <- node_car(status) n_sticky <- node_cdr(status) # Decrease indent level only once for all the openers that were # on a single line if (!reset) { self$indent <- self$indent - 2L node_poke_car(status, TRUE) self$next_indent_sticky <- FALSE } if (n_sticky >= 1L) { node_poke_cdr(status, dec(n_sticky)) } else { self$indent_status <- node_cdr(self$indent_status) self$next_indent_sticky <- FALSE } self } ) } fmls_deparse <- function(x, lines = new_lines()) { lines$push_sticky("(") lines$increase_indent() while (!is_null(x)) { lines$push(as_string(node_tag(x))) car <- node_car(x) if (!is_missing(car)) { lines$push_sticky(" = ") lines$make_next_sticky() lines$deparse(node_car(x)) } x <- node_cdr(x) if (!is_null(x)) { lines$push_sticky(", ") } } lines$push_sticky(")") lines$decrease_indent() lines$get_lines() } fn_call_deparse <- function(x, lines = new_lines()) { lines$push("function") x <- node_cdr(x) fmls_deparse(node_car(x), lines) lines$push_sticky(" ") lines$increase_indent() x <- node_cdr(x) lines$deparse(node_car(x)) lines$decrease_indent() lines$get_lines() } fn_deparse <- function(x, lines) { lines$push("") lines$decrease_indent() lines$get_lines() } while_deparse <- function(x, lines = new_lines()) { x <- node_cdr(x) lines$push("while (") lines$deparse(node_car(x)) x <- node_cdr(x) lines$push(") ") lines$deparse(node_car(x)) lines$get_lines() } for_deparse <- function(x, lines = new_lines()) { x <- node_cdr(x) lines$push("for (") lines$deparse(node_car(x)) x <- node_cdr(x) lines$push(" in ") lines$deparse(node_car(x)) x <- node_cdr(x) lines$push(") ") lines$deparse(node_car(x)) lines$get_lines() } repeat_deparse <- function(x, lines = new_lines()) { lines$push("repeat ") lines$deparse(node_cadr(x)) lines$get_lines() } if_deparse <- function(x, lines = new_lines()) { x <- node_cdr(x) lines$push("if (") lines$deparse(node_car(x)) x <- node_cdr(x) lines$push(") ") lines$deparse(node_car(x)) x <- node_cdr(x) if (!is_null(x)) { lines$push(" else ") lines$deparse(node_car(x)) } lines$get_lines() } # Wrap if the call lower in the AST is not supposed to have # precedence. This sort of AST cannot arise in parsed code but can # occur in constructed calls. operand_deparse <- function(x, parent, side, lines) { wrap <- !call_has_precedence(x, parent, side) if (wrap) { lines$push("(") lines$make_next_sticky() } lines$deparse(x) if (wrap) { lines$push_sticky(")") } } binary_op_deparse <- function(x, lines = new_lines(), space = " ") { outer <- x; op <- as_string(node_car(x)) x <- node_cdr(x) operand_deparse(node_car(x), outer, "lhs", lines) lines$push(paste0(space, op, space)) x <- node_cdr(x) operand_deparse(node_car(x), outer, "rhs", lines) lines$get_lines() } spaced_op_deparse <- function(x, lines = new_lines()) { binary_op_deparse(x, lines, space = " ") } unspaced_op_deparse <- function(x, lines = new_lines()) { binary_op_deparse(x, lines, space = "") } unary_op_deparse <- function(x, lines = new_lines()) { op <- as_string(node_car(x)) lines$push(op) lines$deparse(node_cadr(x)) lines$get_lines() } brackets_deparse <- function(x, lines = new_lines()) { x <- node_cdr(x) lines$deparse(node_car(x)) lines$push_sticky("[") lines$increase_indent() x <- node_cdr(x) lines$deparse(node_car(x)) lines$push_sticky("]") lines$decrease_indent() lines$get_lines() } brackets2_deparse <- function(x, lines = new_lines()) { x <- node_cdr(x) lines$deparse(node_car(x)) lines$push_sticky("[[") lines$increase_indent() x <- node_cdr(x) lines$deparse(node_car(x)) lines$push_sticky("]]") lines$decrease_indent() lines$get_lines() } parens_deparse <- function(x, lines = new_lines()) { lines$push("(") lines$deparse(node_cadr(x)) lines$push(")") lines$get_lines() } braces_deparse <- function(x, lines = new_lines()) { lines$push("{") lines$increase_indent() x <- node_cdr(x) while (!is_null(x)) { lines$push_newline() lines$deparse(node_car(x)) x <- node_cdr(x) } lines$decrease_indent() lines$push_newline() lines$push("}") lines$get_lines() } sym_deparse <- function(x, lines = new_lines()) { lines$push(as_string(x))$get_lines() } args_deparse <- function(x, lines = new_lines()) { lines$push_sticky("(") lines$increase_indent() while (!is_null(x)) { tag <- node_tag(x) if (!is_null(tag)) { lines$push(as_string(tag)) lines$push_sticky(" = ") lines$make_next_sticky() } lines$deparse(node_car(x)) x <- node_cdr(x) if (!is_null(x)) { lines$push_sticky(", ") } } lines$push_sticky(")") lines$decrease_indent() lines$get_lines() } call_deparse <- function(x, lines = new_lines()) { lines$deparse(node_car(x)) args_deparse(node_cdr(x), lines) } op_deparse <- function(op, x, lines) { deparser <- switch (op, `function` = fn_call_deparse, `while` = while_deparse, `for` = for_deparse, `repeat` = repeat_deparse, `if` = if_deparse, `?` = , `<-` = , `<<-` = , `=` = , `:=` = , `~` = , `|` = , `||` = , `&` = , `&&` = , `>` = , `>=` = , `<` = , `<=` = , `==` = , `!=` = , `+` = , `-` = , `*` = , `/` = , `%%` = , `special` = spaced_op_deparse, `:` = , `^` = , `$` = , `@` = , `::` = , `:::` = unspaced_op_deparse, `?unary` = , `~unary` = , `!` = , `!!!` = , `!!` = , `+unary` = , `-unary` = unary_op_deparse, `[` = brackets_deparse, `[[` = brackets2_deparse, `(` = parens_deparse, `{` = braces_deparse, abort("Internal error: Unexpected operator while deparsing") ) deparser(x, lines) lines$get_lines() } call_deparser <- function(x) { op <- which_operator(x) if (op != "") { function(x, lines) op_deparse(op, x, lines) } else { call_deparse } } atom_elements <- function(x) { elts <- as.character(x) na_pos <- are_na(x) elts[na_pos] <- "NA" elts[!na_pos] <- switch (typeof(x), integer = paste0(elts[!na_pos], "L"), character = paste0("\"", elts[!na_pos], "\""), elts[!na_pos] ) elts } is_scalar_deparsable <- function(x) { if (typeof(x) == "raw" || length(x) != 1 || is_named(x)) { return(FALSE) } if (is_na(x) && !is_logical(x)) { return(FALSE) } TRUE } atom_deparse <- function(x, lines = new_lines()) { if (is_scalar_deparsable(x)) { lines$push(atom_elements(x)) return(NULL) } truncated <- length(x) > 5L if (truncated) { x <- .subset(x, 1:5) } lines$push(paste0("<", rlang_type_sum(x), ": ")) lines$increase_indent() elts <- atom_elements(x) nms <- names2(x) n <- length(elts) for (i in seq_len(n)) { nm <- nms[[i]] if (nzchar(nm)) { lines$push(paste0(nm, " = ")) lines$make_next_sticky() } lines$push(elts[[i]]) if (i != n) { lines$push_sticky(", ") } } if (truncated) { lines$push_sticky(", ") lines$push("...") } lines$push_sticky(">") lines$decrease_indent() lines$get_lines() } list_deparse <- function(x, lines = new_lines()) { lines$push(paste0(" 5L if (truncated) { x <- .subset(x, 1:5) } nms <- names2(x) n <- length(x) for (i in seq_len(n)) { nm <- nms[[i]] if (nzchar(nm)) { lines$push(paste0(nm, " = ")) lines$make_next_sticky() } lines$deparse(x[[i]]) if (i != n) { lines$push_sticky(", ") } } if (truncated) { lines$push_sticky(", ") lines$push("...") } lines$push_sticky(">") lines$decrease_indent() lines$get_lines() } s3_deparse <- function(x, lines = new_lines()) { lines$push(paste0("<", rlang_type_sum(x), ">")) lines$get_lines() } literal_deparser <- function(type) { function(x, lines = new_lines()) { lines$push(paste0("<", type, ">")) } } default_deparse <- function(x, lines = new_lines()) { lines$push(deparse(x, control = "keepInteger")) lines$get_lines() } sexp_deparse <- function(x, lines = new_lines()) { if (is.object(x)) { s3_deparse(x, lines) return(NULL) } deparser <- switch (typeof(x), symbol = sym_deparse, language = call_deparser(x), closure = fn_deparse, `...` = literal_deparser("..."), any = literal_deparser("any"), environment = literal_deparser("environment"), externalptr = literal_deparser("pointer"), promise = literal_deparser("promise"), weakref = literal_deparser("weakref"), logical = , integer = , double = , complex = , character = , raw = atom_deparse, list = list_deparse, default_deparse ) deparser(x, lines) lines$get_lines() } rlang/R/vec-bytes.R0000644000176200001440000000115213241233650013600 0ustar liggesusers new_bytes <- function(x) { if (is_integerish(x)) { as.raw(x) } else if (is_raw(x)) { x } else { abort("input should be integerish") } } #' Coerce to a raw vector #' #' This currently only works with strings, and returns its hexadecimal #' representation. #' #' #' @section Life cycle: #' #' Raw vector functions are experimental. #' #' @param x A string. #' @return A raw vector of bytes. #' @keywords internal #' @export as_bytes <- function(x) { switch(typeof(x), raw = return(x), character = if (is_string(x)) return(charToRaw(x)) ) abort("`x` must be a string or raw vector") } rlang/R/lifecycle.R0000644000176200001440000000737113241233650013647 0ustar liggesusers#' Life cycle of the rlang package #' #' @description #' #' The rlang package is currently maturing. Unless otherwise stated, #' this applies to all its exported functions. Maturing functions are #' susceptible to API changes. Only use these in packages if you're #' prepared to make changes as the package evolves. See sections below #' for a list of functions marked as stable. #' #' The documentation pages of retired functions contain life cycle #' sections that explain the reasons for their retirements. #' #' #' @section Stable functions: #' #' * [eval_tidy()] #' * [!!], [!!!] #' * [enquo()], [quo()], [quos()] #' * [enexpr()], [expr()], [exprs()] #' * [sym()], [syms()] #' * [new_quosure()], [is_quosure()] #' * [missing_arg()], [is_missing()] #' #' * [quo_get_expr()], [quo_set_expr()] #' * [quo_get_env()], [quo_set_env()] #' #' * [eval_bare()] #' #' * [set_names()], [names2()] #' * [as_function()] #' #' #' @section Experimental functions: #' #' These functions are not yet part of the rlang API. Expect breaking #' changes. #' #' * [type_of()], [switch_type()], [coerce_type()] #' * [switch_class()], [coerce_class()] #' * [lang_type_of()], [switch_lang()], [coerce_lang()] #' * [set_attrs()], [mut_attrs()] #' * [with_env()], [locally()] #' * [env_poke()] #' #' * [env_bind_fns()], [env_bind_exprs()] #' * [pkg_env()], [pkg_env_name()] #' * [scoped_env()], [scoped_names()], [scoped_envs()], [is_scoped()] #' * [ns_env()], [ns_imports_env()], [ns_env_name()] #' #' * [is_pairlist()], [as_pairlist()], [is_node()], [is_node_list()] #' * [is_definition()], [new_definition()], [is_formulaish()], #' [dots_definitions()] #' #' * [scoped_options()], [with_options()], [push_options()], #' [peek_options()], [peek_option()] #' #' * [as_bytes()], [chr_unserialise_unicode()], [set_chr_encoding()], #' [chr_encoding()], [set_str_encoding()], [str_encoding()] #' #' * [mut_utf8_locale()], [mut_latin1_locale()], [mut_mbcs_locale()] #' #' * [prepend()], [modify()] #' #' #' @section Questioning functions: #' #' * [UQ()], [UQS()] #' #' * [dots_splice()], [splice()] #' * [invoke()] #' #' * [is_frame()], [global_frame()], [current_frame()], #' [ctxt_frame()], [call_frame()], [frame_position()] #' #' * [ctxt_depth()], [call_depth()], [ctxt_stack()], [call_stack()], #' [stack_trim()] #' #' #' @section Soft-deprecated functions and arguments: #' #' **Retired in rlang 0.2.0:** #' #' * [eval_tidy_()] #' * [overscope_clean()] #' * [overscope_eval_next()] => [eval_tidy()] #' #' * [lang_head()], [lang_tail()] #' #' #' **Renamed in rlang 0.2.0:** #' #' * [quo_expr()] => [quo_squash()] #' * [parse_quosure()] => [parse_quo()] #' * [parse_quosures()] => [parse_quos()] #' * [as_overscope()] => [as_data_mask()] #' * [new_overscope()] => [new_data_mask()] #' * [as_dictionary()] => [as_data_pronoun()] #' #' * [lang()] => [call2()] #' * [new_language()] => [new_call()] #' * [is_lang()] => [is_call()] #' * [is_unary_lang()] => Use the `n` argument of [is_call()] #' * [is_binary_lang()] => Use the `n` argument of [is_call()] #' * [quo_is_lang()] => [quo_is_call()] #' * [is_expr()] => [is_expression()] #' #' * [lang_modify()] => [call_modify()] #' * [lang_standardise()] => [call_standardise()] #' * [lang_fn()] => [call_fn()] #' * [lang_name()] => [call_name()] #' * [lang_args()] => [call_args()] #' * [lang_args_names()] => [call_args_names()] #' #' #' @section Deprecated functions and arguments: #' #' **Retired in rlang 0.2.0:** #' #' * [UQE()] #' * [is_quosureish()], [as_quosureish()] #' #' #' **Renamed in rlang 0.2.0** #' #' * [new_cnd()] => [cnd()] #' * [cnd_message()] => [message_cnd()] #' * [cnd_warning()] => [warning_cnd()] #' * [cnd_error()] => [error_cnd()] #' #' #' @section Defunct functions and arguments: #' #' **Retired in rlang 0.2.0:** #' #' * [:=][quasiquotation] #' #' @name lifecycle NULL rlang/R/state.R0000644000176200001440000000504013241233650013017 0ustar liggesusers#' Change global options #' #' @description #' #' * `scoped_options()` changes options for the duration of a stack #' frame (by default the current one). Options are set back to their #' old values when the frame returns. #' #' * `with_options()` changes options while an expression is #' evaluated. Options are restored when the expression returns. #' #' * `push_options()` adds or changes options permanently. #' #' * `peek_option()` and `peek_options()` return option values. The #' former returns the option directly while the latter returns a #' list. #' #' #' @section Life cycle: #' #' These functions are experimental. #' #' @param ... For `scoped_options()` and `push_options()`, named #' values defining new option values. For `peek_options()`, strings #' or character vectors of option names. #' @param .frame The environment of a stack frame which defines the #' scope of the temporary options. When the frame returns, the #' options are set back to their original values. #' @return For `scoped_options()` and `push_options()`, the old option #' values. `peek_option()` returns the current value of an option #' while the plural `peek_options()` returns a list of current #' option values. #' #' @keywords experimental #' @export #' @examples #' # Store and retrieve a global option: #' push_options(my_option = 10) #' peek_option("my_option") #' #' # Change the option temporarily: #' with_options(my_option = 100, peek_option("my_option")) #' peek_option("my_option") #' #' # The scoped variant is useful within functions: #' fn <- function() { #' scoped_options(my_option = 100) #' peek_option("my_option") #' } #' fn() #' peek_option("my_option") #' #' # The plural peek returns a named list: #' peek_options("my_option") #' peek_options("my_option", "digits") scoped_options <- function(..., .frame = caller_env()) { options <- dots_list(...) stopifnot(is_named(options)) old <- options(options) options_lang <- call2(base::options, !!! old) scoped_exit(!! options_lang, frame = .frame) invisible(old) } #' @rdname scoped_options #' @param .expr An expression to evaluate with temporary options. #' @export with_options <- function(.expr, ...) { scoped_options(...) .expr } #' @rdname scoped_options #' @export push_options <- function(...) { options(dots_list(...)) } #' @rdname scoped_options #' @export peek_options <- function(...) { names <- set_names(chr(...)) map(names, getOption) } #' @rdname scoped_options #' @param name An option name as string. #' @export peek_option <- function(name) { getOption(name) } rlang/R/fn.R0000644000176200001440000004023513241233650012307 0ustar liggesusers#' Create a function #' #' This constructs a new function given it's three components: #' list of arguments, body code and parent environment. #' #' @param args A named list of default arguments. Note that if you #' want arguments that don't have defaults, you'll need to use the #' special function [alist], e.g. `alist(a = , b = 1)` #' @param body A language object representing the code inside the #' function. Usually this will be most easily generated with #' [base::quote()] #' @param env The parent environment of the function, defaults to the #' calling environment of `new_function()` #' @export #' @examples #' f <- function(x) x + 3 #' g <- new_function(alist(x = ), quote(x + 3)) #' #' # The components of the functions are identical #' identical(formals(f), formals(g)) #' identical(body(f), body(g)) #' identical(environment(f), environment(g)) #' #' # But the functions are not identical because f has src code reference #' identical(f, g) #' #' attr(f, "srcref") <- NULL #' # Now they are: #' stopifnot(identical(f, g)) new_function <- function(args, body, env = caller_env()) { stopifnot(all(have_name(args)), is_expression(body), is_env(env)) args <- as.pairlist(args) eval_bare(call("function", args, body), env) } prim_eval <- eval(quote(sys.function(0))) is_prim_eval <- function(x) identical(x, prim_eval) #' Name of a primitive function #' @param prim A primitive function such as [base::c()]. #' @export prim_name <- function(prim) { stopifnot(is_primitive(prim)) # Workaround because R_FunTab is not public name <- format(prim) name <- sub("^.Primitive\\(\"", "", name) name <- sub("\"\\)$", "", name) name } #' Extract arguments from a function #' #' `fn_fmls()` returns a named list of formal arguments. #' `fn_fmls_names()` returns the names of the arguments. #' `fn_fmls_syms()` returns formals as a named list of symbols. This #' is especially useful for forwarding arguments in [constructed #' calls][lang]. #' #' Unlike `formals()`, these helpers also work with primitive #' functions. See [is_function()] for a discussion of primitive and #' closure functions. #' #' Note that the argument names are taken from the closures that are #' created when passing the primitive to [as_closure()]. For instance, #' while the arguments of the primitive operator `+` are labelled `e1` #' and `e2`, `fn_fmls_names()` will return `.x` and `.y`. Note that #' for many primitives the base R argument names are purely #' placeholders since they don't perform regular argument matching. #' E.g. this returns `5` instead of `-5`: #' #' ``` #' `-`(e2 = 10, 5) #' ``` #' #' To regularise the semantics of primitive functions, it is usually a #' good idea to coerce them to a closure first: #' #' ``` #' minus <- as_closure(`-`) #' minus(.y = 10, 5) #' ``` #' #' @param fn A function. It is lookep up in the calling frame if not #' supplied. #' @seealso [call_args()] and [call_args_names()] #' @export #' @examples #' # Extract from current call: #' fn <- function(a = 1, b = 2) fn_fmls() #' fn() #' #' # Works with primitive functions: #' fn_fmls(base::switch) #' #' # fn_fmls_syms() makes it easy to forward arguments: #' call2("apply", !!! fn_fmls_syms(lapply)) #' #' # You can also change the formals: #' fn_fmls(fn) <- list(A = 10, B = 20) #' fn() #' #' fn_fmls_names(fn) <- c("foo", "bar") #' fn() fn_fmls <- function(fn = caller_fn()) { fn <- as_closure(fn) formals(fn) } #' @rdname fn_fmls #' @export fn_fmls_names <- function(fn = caller_fn()) { args <- fn_fmls(fn) names(args) } #' @rdname fn_fmls #' @export fn_fmls_syms <- function(fn = caller_fn()) { fmls_nms <- fn_fmls_names(fn) if (is_null(fmls_nms)) { return(list()) } nms <- set_names(fmls_nms) names(nms)[match("...", nms)] <- "" syms(nms) } #' @rdname fn_fmls #' @param value New formals or formals names for `fn`. #' @export `fn_fmls<-` <- function(fn, value) { fn <- as_closure(fn) attrs <- attributes(fn) formals(fn) <- value # Work around bug in base R attributes(fn) <- attrs fn } #' @rdname fn_fmls #' @export `fn_fmls_names<-` <- function(fn, value) { fn <- as_closure(fn) attrs <- attributes(fn) fmls <- formals(fn) names(fmls) <- value formals(fn) <- fmls # Work around bug in base R attributes(fn) <- attrs fn } #' Get or set function body #' #' `fn_body()` is a simple wrapper around `base::body()`. The setter #' version preserves attributes, unlike `body<-`. #' #' @inheritParams fn_fmls #' #' @export fn_body <- function(fn = caller_fn()) { if(!is_closure(fn)) { abort("`fn` is not a closure") } body(fn) } #' @rdname fn_body #' @export `fn_body<-` <- function(fn, value) { attrs <- attributes(fn) body(fn) <- value # Work around bug in base R. First remove source references since # the body has changed attrs$srcref <- NULL attributes(fn) <- attrs fn } #' Is object a function? #' #' The R language defines two different types of functions: primitive #' functions, which are low-level, and closures, which are the regular #' kind of functions. #' #' Closures are functions written in R, named after the way their #' arguments are scoped within nested environments (see #' https://en.wikipedia.org/wiki/Closure_(computer_programming)). The #' root environment of the closure is called the closure #' environment. When closures are evaluated, a new environment called #' the evaluation frame is created with the closure environment as #' parent. This is where the body of the closure is evaluated. These #' closure frames appear on the evaluation stack (see [ctxt_stack()]), #' as opposed to primitive functions which do not necessarily have #' their own evaluation frame and never appear on the stack. #' #' Primitive functions are more efficient than closures for two #' reasons. First, they are written entirely in fast low-level #' code. Secondly, the mechanism by which they are passed arguments is #' more efficient because they often do not need the full procedure of #' argument matching (dealing with positional versus named arguments, #' partial matching, etc). One practical consequence of the special #' way in which primitives are passed arguments this is that they #' technically do not have formal arguments, and [formals()] will #' return `NULL` if called on a primitive function. See [fn_fmls()] #' for a function that returns a representation of formal arguments #' for primitive functions. Finally, primitive functions can either #' take arguments lazily, like R closures do, or evaluate them eagerly #' before being passed on to the C code. The former kind of primitives #' are called "special" in R terminology, while the latter is referred #' to as "builtin". `is_primitive_eager()` and `is_primitive_lazy()` #' allow you to check whether a primitive function evaluates arguments #' eagerly or lazily. #' #' You will also encounter the distinction between primitive and #' internal functions in technical documentation. Like primitive #' functions, internal functions are defined at a low level and #' written in C. However, internal functions have no representation in #' the R language. Instead, they are called via a call to #' [base::.Internal()] within a regular closure. This ensures that #' they appear as normal R function objects: they obey all the usual #' rules of argument passing, and they appear on the evaluation stack #' as any other closures. As a result, [fn_fmls()] does not need to #' look in the `.ArgsEnv` environment to obtain a representation of #' their arguments, and there is no way of querying from R whether #' they are lazy ('special' in R terminology) or eager ('builtin'). #' #' You can call primitive functions with [.Primitive()] and internal #' functions with [.Internal()]. However, calling internal functions #' in a package is forbidden by CRAN's policy because they are #' considered part of the private API. They often assume that they #' have been called with correctly formed arguments, and may cause R #' to crash if you call them with unexpected objects. #' #' @inheritParams type-predicates #' @export #' @examples #' # Primitive functions are not closures: #' is_closure(base::c) #' is_primitive(base::c) #' #' # On the other hand, internal functions are wrapped in a closure #' # and appear as such from the R side: #' is_closure(base::eval) #' #' # Both closures and primitives are functions: #' is_function(base::c) #' is_function(base::eval) #' #' # Primitive functions never appear in evaluation stacks: #' is_primitive(base::`[[`) #' is_primitive(base::list) #' list(ctxt_stack())[[1]] #' #' # While closures do: #' identity(identity(ctxt_stack())) is_function <- function(x) { is_closure(x) || is_primitive(x) } #' @export #' @rdname is_function is_closure <- function(x) { typeof(x) == "closure" } #' @export #' @rdname is_function is_primitive <- function(x) { typeof(x) %in% c("builtin", "special") } #' @export #' @rdname is_function #' @examples #' #' # Many primitive functions evaluate arguments eagerly: #' is_primitive_eager(base::c) #' is_primitive_eager(base::list) #' is_primitive_eager(base::`+`) is_primitive_eager <- function(x) { typeof(x) == "builtin" } #' @export #' @rdname is_function #' @examples #' #' # However, primitives that operate on expressions, like quote() or #' # substitute(), are lazy: #' is_primitive_lazy(base::quote) #' is_primitive_lazy(base::substitute) is_primitive_lazy <- function(x) { typeof(x) == "special" } #' Return the closure environment of a function #' #' Closure environments define the scope of functions (see [env()]). #' When a function call is evaluated, R creates an evaluation frame #' (see [ctxt_stack()]) that inherits from the closure environment. #' This makes all objects defined in the closure environment and all #' its parents available to code executed within the function. #' #' `fn_env()` returns the closure environment of `fn`. There is also #' an assignment method to set a new closure environment. #' #' @param fn,x A function. #' @param value A new closure environment for the function. #' @export #' @examples #' env <- child_env("base") #' fn <- with_env(env, function() NULL) #' identical(fn_env(fn), env) #' #' other_env <- child_env("base") #' fn_env(fn) <- other_env #' identical(fn_env(fn), other_env) fn_env <- function(fn) { if(!is_function(fn)) { abort("`fn` is not a function") } environment(fn) } #' @export #' @rdname fn_env `fn_env<-` <- function(x, value) { if(!is_function(x)) { abort("`fn` is not a function") } environment(x) <- value x } #' Convert to function or closure #' #' @description #' #' * `as_function()` transform objects to functions. It fetches #' functions by name if supplied a string or transforms #' [quosures][quotation] to a proper function. #' #' * `as_closure()` first passes its argument to `as_function()`. If #' the result is a primitive function, it regularises it to a proper #' [closure] (see [is_function()] about primitive functions). #' #' @param x A function or formula. #' #' If a **function**, it is used as is. #' #' If a **formula**, e.g. `~ .x + 2`, it is converted to a function #' with two arguments, `.x` or `.` and `.y`. This allows you to #' create very compact anonymous functions with up to two inputs. #' @param env Environment in which to fetch the function in case `x` #' is a string. #' @export #' @examples #' f <- as_function(~ . + 1) #' f(10) #' #' # Primitive functions are regularised as closures #' as_closure(list) #' as_closure("list") #' #' # Operators have `.x` and `.y` as arguments, just like lambda #' # functions created with the formula syntax: #' as_closure(`+`) #' as_closure(`~`) as_function <- function(x, env = caller_env()) { coerce_type(x, friendly_type("function"), primitive = , closure = { x }, formula = { if (length(x) > 2) { abort("Can't convert a two-sided formula to a function") } args <- list(... = missing_arg(), .x = quote(..1), .y = quote(..2), . = quote(..1)) new_function(args, f_rhs(x), f_env(x)) }, string = { get(x, envir = env, mode = "function") } ) } #' @rdname as_function #' @export as_closure <- function(x, env = caller_env()) { x <- as_function(x, env = env) coerce_type(x, "a closure", closure = x, primitive = { fn_name <- prim_name(x) fn <- op_as_closure(fn_name) if (!is_null(fn)) { return(fn) } if (fn_name == "eval") { # do_eval() starts a context with a fake primitive function as # function definition. We replace it here with the .Internal() # wrapper of eval() so we can match the arguments. fmls <- formals(base::eval) } else { fmls <- formals(.ArgsEnv[[fn_name]] %||% .GenericArgsEnv[[fn_name]]) } args <- syms(names(fmls)) args <- set_names(args) names(args)[(names(args) == "...")] <- "" prim_call <- call2(fn_name, splice(args)) new_function(fmls, prim_call, base_env()) } ) } utils::globalVariables(c("!<-", "(<-", "enexpr<-")) op_as_closure <- function(prim_nm) { switch(prim_nm, `<-` = , `<<-` = , `=` = function(.x, .y) { op <- sym(prim_nm) expr <- expr((!!op)(!!enexpr(.x), !!enexpr(.y))) eval_bare(expr, caller_env()) }, `@` = , `$` = function(.x, .i) { op <- sym(prim_nm) expr <- expr((!!op)(.x, !! quo_expr(enexpr(.i), warn = TRUE))) eval_bare(expr) }, `[[<-` = function(.x, .i, .value) { expr <- expr((!!enexpr(.x))[[!!enexpr(.i)]] <- !!enexpr(.value)) eval_bare(expr, caller_env()) }, `[<-` = function(.x, ...) { args <- exprs(...) n <- length(args) if (n < 2L) { abort("Must supply operands to `[<-`") } expr <- expr((!!enexpr(.x))[!!!args[-n]] <- !!args[[n]]) eval_bare(expr, caller_env()) }, `@<-` = function(.x, .i, .value) { expr <- expr(`@`(!!enexpr(.x), !!enexpr(.i)) <- !!enexpr(.value)) eval_bare(expr, caller_env()) }, `$<-` = function(.x, .i, .value) { expr <- expr(`$`(!!enexpr(.x), !!enexpr(.i)) <- !!enexpr(.value)) eval_bare(expr, caller_env()) }, `(` = function(.x) .x, `[` = function(.x, ...) .x[...], `[[` = function(.x, ...) .x[[...]], `{` = function(...) { values <- list(...) values[[length(values)]] }, `&` = function(.x, .y) .x & .y, `|` = function(.x, .y) .x | .y, `&&` = function(.x, .y) .x && .y, `||` = function(.x, .y) .x || .y, `!` = function(.x) !.x, `+` = function(.x, .y) if (missing(.y)) .x else .x + .y, `-` = function(.x, .y) if (missing(.y)) -.x else .x - .y, `*` = function(.x, .y) .x * .y, `/` = function(.x, .y) .x / .y, `^` = function(.x, .y) .x ^ .y, `%%` = function(.x, .y) .x %% .y, `<` = function(.x, .y) .x < .y, `<=` = function(.x, .y) .x <= .y, `>` = function(.x, .y) .x > .y, `>=` = function(.x, .y) .x >= .y, `==` = function(.x, .y) .x == .y, `!=` = function(.x, .y) .x != .y, `:` = function(.x, .y) .x : .y, `~` = function(.x, .y) { if (is_missing(substitute(.y))) { new_formula(NULL, substitute(.x), caller_env()) } else { new_formula(substitute(.x), substitute(.y), caller_env()) } }, # Unsupported primitives `break` = , `for` = , `function` = , `if` = , `next` = , `repeat` = , `return` = , `while` = { nm <- chr_quoted(prim_nm) abort(paste0("Can't coerce the primitive function ", nm, " to a closure")) } ) } #' Make an `fn` object #' #' @noRd #' @description #' #' `new_fn()` takes a function and sets the class to `c("fn", #' function)`. #' #' * Inheriting from `"fn"` enables a print method that strips all #' attributes (except `srcref`) before printing. This is currently #' the only purpose of the `fn` class. #' #' * Inheriting from `"function"` makes sure your function still #' dispatches on type methods. #' #' @param fn A closure. #' @return An object of class `c("fn", "function")`. #' @examples #' fn <- set_attrs(function() "foo", attribute = "foobar") #' print(fn) #' #' # The `fn` object doesn't print with attributes: #' fn <- new_fn(fn) #' print(fn) new_fn <- function(fn) { stopifnot(is_closure(fn)) set_attrs(fn, class = c("fn", "function")) } print.fn <- function(x, ...) { srcref <- attr(x, "srcref") x <- set_attrs(x, NULL) x <- set_attrs(x, srcref = srcref) print(x) } rlang/R/compat-lazyeval.R0000644000176200001440000000422713241233650015015 0ustar liggesusers# nocov start - compat-lazyeval (last updated: rlang 0.2.0) # This file serves as a reference for compatibility functions for lazyeval. # Please find the most recent version in rlang's repository. warn_underscored <- function() { return(NULL) warn(paste( "The underscored versions are deprecated in favour of", "tidy evaluation idioms. Please see the documentation", "for `quo()` in rlang" )) } warn_text_se <- function() { return(NULL) warn("Text parsing is deprecated, please supply an expression or formula") } compat_lazy <- function(lazy, env = caller_env(), warn = TRUE) { if (warn) warn_underscored() if (missing(lazy)) { return(quo()) } if (is_quosure(lazy)) { return(lazy) } if (is_formula(lazy)) { return(as_quosure(lazy, env)) } out <- switch(typeof(lazy), symbol = , language = new_quosure(lazy, env), character = { if (warn) warn_text_se() parse_quo(lazy[[1]], env) }, logical = , integer = , double = { if (length(lazy) > 1) { warn("Truncating vector to length 1") lazy <- lazy[[1]] } new_quosure(lazy, env) }, list = if (inherits(lazy, "lazy")) { lazy = new_quosure(lazy$expr, lazy$env) } ) if (is_null(out)) { abort(sprintf("Can't convert a %s to a quosure", typeof(lazy))) } else { out } } compat_lazy_dots <- function(dots, env, ..., .named = FALSE) { if (missing(dots)) { dots <- list() } if (inherits(dots, c("lazy", "formula"))) { dots <- list(dots) } else { dots <- unclass(dots) } dots <- c(dots, list(...)) warn <- TRUE for (i in seq_along(dots)) { dots[[i]] <- compat_lazy(dots[[i]], env, warn) warn <- FALSE } named <- have_name(dots) if (.named && any(!named)) { nms <- map_chr(dots[!named], function(x) expr_text(get_expr(x))) names(dots)[!named] <- nms } names(dots) <- names2(dots) dots } compat_as_lazy <- function(quo) { structure(class = "lazy", list( expr = get_expr(quo), env = get_env(quo) )) } compat_as_lazy_dots <- function(...) { structure(class = "lazy_dots", map(quos(...), compat_as_lazy)) } # nocov end rlang/R/vec-chr.R0000644000176200001440000002554013241233650013235 0ustar liggesusers#' Create a string #' #' These base-type constructors allow more control over the creation #' of strings in R. They take character vectors or string-like objects #' (integerish or raw vectors), and optionally set the encoding. The #' string version checks that the input contains a scalar string. #' #' @param x A character vector or a vector or list of string-like #' objects. #' @param encoding If non-null, passed to [set_chr_encoding()] to add #' an encoding mark. This is only declarative, no encoding #' conversion is performed. #' @seealso `set_chr_encoding()` for more information #' about encodings in R. #' @export #' @examples #' # As everywhere in R, you can specify a string with Unicode #' # escapes. The characters corresponding to Unicode codepoints will #' # be encoded in UTF-8, and the string will be marked as UTF-8 #' # automatically: #' cafe <- string("caf\uE9") #' str_encoding(cafe) #' as_bytes(cafe) #' #' # In addition, string() provides useful conversions to let #' # programmers control how the string is represented in memory. For #' # encodings other than UTF-8, you'll need to supply the bytes in #' # hexadecimal form. If it is a latin1 encoding, you can mark the #' # string explicitly: #' cafe_latin1 <- string(c(0x63, 0x61, 0x66, 0xE9), "latin1") #' str_encoding(cafe_latin1) #' as_bytes(cafe_latin1) string <- function(x, encoding = NULL) { if (is_integerish(x)) { x <- rawToChar(as.raw(x)) } else if (is_raw(x)) { x <- rawToChar(x) } else if (!is_string(x)) { abort("`x` must be a string or raw vector") } set_chr_encoding(x, encoding) } #' Coerce to a character vector and attempt encoding conversion #' #' @description #' #' Unlike specifying the `encoding` argument in `as_string()` and #' `as_character()`, which is only declarative, these functions #' actually attempt to convert the encoding of their input. There are #' two possible cases: #' #' * The string is tagged as UTF-8 or latin1, the only two encodings #' for which R has specific support. In this case, converting to the #' same encoding is a no-op, and converting to native always works #' as expected, as long as the native encoding, the one specified by #' the `LC_CTYPE` locale (see [mut_utf8_locale()]) has support for #' all characters occurring in the strings. Unrepresentable #' characters are serialised as unicode points: "". #' #' * The string is not tagged. R assumes that it is encoded in the #' native encoding. Conversion to native is a no-op, and conversion #' to UTF-8 should work as long as the string is actually encoded in #' the locale codeset. #' #' When translating to UTF-8, the strings are parsed for serialised #' unicode points (e.g. strings looking like "U+xxxx") with #' [chr_unserialise_unicode()]. This helps to alleviate the effects of #' character-to-symbol-to-character roundtrips on systems with #' non-UTF-8 native encoding. #' #' @param x An object to coerce. #' @export #' @examples #' # Let's create a string marked as UTF-8 (which is guaranteed by the #' # Unicode escaping in the string): #' utf8 <- "caf\uE9" #' str_encoding(utf8) #' as_bytes(utf8) #' #' # It can then be converted to a native encoding, that is, the #' # encoding specified in the current locale: #' \dontrun{ #' mut_latin1_locale() #' latin1 <- as_native_string(utf8) #' str_encoding(latin1) #' as_bytes(latin1) #' } as_utf8_character <- function(x) { .Call(rlang_unescape_character, as_character(x)) } #' @rdname as_utf8_character #' @export as_native_character <- function(x) { enc2native(as_character(x)) } #' @rdname as_utf8_character #' @export as_utf8_string <- function(x) { coerce_type(x, "an UTF-8 string", symbol = , string = enc2utf8(as_string(x)) ) } #' @rdname as_utf8_character #' @export as_native_string <- function(x) { coerce_type(x, "a natively encoded string", symbol = , string = enc2native(as_string(x)) ) } #' Translate unicode points to UTF-8 #' #' @description #' #' For historical reasons, R translates strings to the native encoding #' when they are converted to symbols. This string-to-symbol #' conversion is not a rare occurrence and happens for instance to the #' names of a list of arguments converted to a call by `do.call()`. #' #' If the string contains unicode characters that cannot be #' represented in the native encoding, R serialises those as a ASCII #' sequence representing the unicode point. This is why Windows users #' with western locales often see strings looking like ``. To #' alleviate some of the pain, rlang parses strings and looks for #' serialised unicode points to translate them back to the proper #' UTF-8 representation. This transformation occurs automatically in #' functions like [env_names()] and can be manually triggered with #' `as_utf8_character()` and `chr_unserialise_unicode()`. #' #' #' @section Life cycle: #' #' This function is experimental. #' #' @param chr A character vector. #' @export #' @keywords internal #' @examples #' ascii <- "" #' chr_unserialise_unicode(ascii) #' #' identical(chr_unserialise_unicode(ascii), "\u5e78") chr_unserialise_unicode <- function(chr) { stopifnot(is_character(chr)) .Call(rlang_unescape_character, chr) } #' Set encoding of a string or character vector #' #' R has specific support for UTF-8 and latin1 encoded strings. This #' mostly matters for internal conversions. Thanks to this support, #' you can reencode strings to UTF-8 or latin1 for internal #' processing, and return these strings without having to convert them #' back to the native encoding. However, it is important to make sure #' the encoding mark has not been lost in the process, otherwise the #' output will be treated as if encoded according to the current #' locale (see [mut_utf8_locale()] for documentation about locale #' codesets), which is not appropriate if it does not coincide with #' the actual encoding. In those situations, you can use these #' functions to ensure an encoding mark in your strings. #' #' #' @section Life cycle: #' #' These functions are experimental. They might be removed in the #' future because they don't bring anything new over the base API. #' #' @param x A string or character vector. #' @param encoding Either an encoding specially handled by R #' (`"UTF-8"` or `"latin1"`), `"bytes"` to inhibit all encoding #' conversions, or `"unknown"` if the string should be treated as #' encoded in the current locale codeset. #' @seealso [mut_utf8_locale()] about the effects of the locale, and #' [as_utf8_string()] about encoding conversion. #' @export #' @keywords internal #' @examples #' # Encoding marks are always ignored on ASCII strings: #' str_encoding(set_str_encoding("cafe", "UTF-8")) #' #' # You can specify the encoding of strings containing non-ASCII #' # characters: #' cafe <- string(c(0x63, 0x61, 0x66, 0xC3, 0xE9)) #' str_encoding(cafe) #' str_encoding(set_str_encoding(cafe, "UTF-8")) #' #' #' # It is important to consistently mark the encoding of strings #' # because R and other packages perform internal string conversions #' # all the time. Here is an example with the names attribute: #' latin1 <- string(c(0x63, 0x61, 0x66, 0xE9), "latin1") #' latin1 <- set_names(latin1) #' #' # The names attribute is encoded in latin1 as we would expect: #' str_encoding(names(latin1)) #' #' # However the names are converted to UTF-8 by the c() function: #' str_encoding(names(c(latin1))) #' as_bytes(names(c(latin1))) #' #' # Bad things happen when the encoding marker is lost and R performs #' # a conversion. R will assume that the string is encoded according #' # to the current locale: #' \dontrun{ #' bad <- set_names(set_str_encoding(latin1, "unknown")) #' mut_utf8_locale() #' #' str_encoding(names(c(bad))) #' as_bytes(names(c(bad))) #' } set_chr_encoding <- function(x, encoding = c("unknown", "UTF-8", "latin1", "bytes")) { if (!is_null(encoding)) { Encoding(x) <- arg_match(encoding) } x } #' @rdname set_chr_encoding #' @export chr_encoding <- function(x) { Encoding(x) } #' @rdname set_chr_encoding #' @export set_str_encoding <- function(x, encoding = c("unknown", "UTF-8", "latin1", "bytes")) { stopifnot(is_string(x)) set_chr_encoding(x, encoding) } #' @rdname set_chr_encoding #' @export str_encoding <- function(x) { stopifnot(is_string(x)) Encoding(x) } #' Set the locale's codeset for testing #' #' Setting a locale's codeset (specifically, the `LC_CTYPE` category) #' produces side effects in R's handling of strings. The most #' important of these affects how the R parser marks strings. R has #' specific internal support for latin1 (single-byte encoding) and #' UTF-8 (multi-bytes variable-width encoding) strings. If the locale #' codeset is latin1 or UTF-8, the parser will mark all strings with #' the corresponding encoding. It is important for strings to have #' consistent encoding markers, as they determine a number of internal #' encoding conversions when R or packages handle strings (see #' [set_str_encoding()] for some examples). #' #' If you are changing the locale encoding for testing purposes, you #' need to be aware that R caches strings and symbols to save #' memory. If you change the locale during an R session, it can lead #' to surprising and difficult to reproduce results. In doubt, restart #' your R session. #' #' Note that these helpers are only provided for testing interactively #' the effects of changing locale codeset. They let you quickly change #' the default text encoding to latin1, UTF-8, or non-UTF-8 MBCS. They #' are not widely tested and do not provide a way of setting the #' language and region of the locale. They have permanent side effects #' and should probably not be used in package examples, unit tests, or #' in the course of a data analysis. Note finally that #' `mut_utf8_locale()` will not work on Windows as only latin1 and #' MBCS locales are supported on this OS. #' #' #' @section Life cycle: #' #' These functions are experimental. They might be removed in the #' future because they don't bring anything new over the base API. #' #' @return The previous locale (invisibly). #' @keywords internal #' @export mut_utf8_locale <- function() { if (.Platform$OS.type == "windows") { warn("UTF-8 is not supported on Windows") } else { inform("Locale codeset is now UTF-8") mut_ctype("en_US.UTF-8") } } #' @rdname mut_utf8_locale #' @export mut_latin1_locale <- function() { if (.Platform$OS.type == "windows") { locale <- "English_United States.1252" } else { locale <- "en_US.ISO8859-1" } inform("Locale codeset is now latin1") mut_ctype(locale) } #' @rdname mut_utf8_locale #' @export mut_mbcs_locale <- function() { if (.Platform$OS.type == "windows") { locale <- "English_United States.932" } else { locale <- "ja_JP.SJIS" } inform("Locale codeset is now of non-UTF-8 MBCS type") mut_ctype(locale) } mut_ctype <- function(x) { if (is_null(x)) return(x) # Workaround bug in Sys.setlocale() old <- Sys.getlocale("LC_CTYPE") Sys.setlocale("LC_CTYPE", locale = x) invisible(old) } rlang/R/rlang.R0000644000176200001440000000030013241233650012774 0ustar liggesusers#' @useDynLib rlang, .registration = TRUE NULL .onLoad <- function(lib, pkg) { init_c_constants() .Call(rlang_library_load) } .onUnload <- function(lib) { .Call(rlang_library_unload) } rlang/R/parse.R0000644000176200001440000000622413241265017013020 0ustar liggesusers#' Parse R code #' #' These functions parse and transform text into R expressions. This #' is the first step to interpret or evaluate a piece of R code #' written by a programmer. #' #' `parse_expr()` returns one expression. If the text contains more #' than one expression (separated by semicolons or new lines), an error is #' issued. On the other hand `parse_exprs()` can handle multiple #' expressions. It always returns a list of expressions (compare to #' [base::parse()] which returns an base::expression vector). All #' functions also support R connections. #' #' The versions suffixed with `_quo` and `quos` return #' [quosures][quotation] rather than raw expressions. #' #' #' @section Life cycle: #' #' - `parse_quosure()` and `parse_quosures()` were soft-deprecated in #' rlang 0.2.0 and renamed to `parse_quo()` and `parse_quos()`. This #' is consistent with the rule that abbreviated suffixes indicate #' the return type of a function. #' #' @param x Text containing expressions to parse_expr for #' `parse_expr()` and `parse_exprs()`. Can also be an R connection, #' for instance to a file. If the supplied connection is not open, #' it will be automatically closed and destroyed. #' @param env The environment for the quosures. Depending on the use #' case, a good default might be the [global #' environment][global_env] but you might also want to evaluate the #' R code in an isolated context (perhaps a child of the global #' environment or of the [base environment][base_env]). #' @return `parse_expr()` returns an [expression][is_expression], #' `parse_exprs()` returns a list of expressions. #' @seealso [base::parse()] #' @export #' @examples #' # parse_expr() can parse any R expression: #' parse_expr("mtcars %>% dplyr::mutate(cyl_prime = cyl / sd(cyl))") #' #' # A string can contain several expressions separated by ; or \n #' parse_exprs("NULL; list()\n foo(bar)") #' #' # You can also parse source files by passing a R connection. Let's #' # create a file containing R code: #' path <- tempfile("my-file.R") #' cat("1; 2; mtcars", file = path) #' #' # We can now parse it by supplying a connection: #' parse_exprs(file(path)) parse_expr <- function(x) { exprs <- parse_exprs(x) n <- length(exprs) if (n == 0) { abort("No expression to parse") } else if (n > 1) { abort("More than one expression parsed") } exprs[[1]] } #' @rdname parse_expr #' @export parse_exprs <- function(x) { if (inherits(x, "connection")) { if (!isOpen(x)) { open(x) on.exit(close(x)) } exprs <- parse(file = x) } else if (is_scalar_character(x)) { exprs <- parse(text = x) } else { abort("`x` must be a string or a R connection") } as.list(exprs) } #' @rdname parse_expr #' @usage NULL #' @export parse_quo <- function(x, env) { if (missing(env)) { abort("The quosure environment should be explicitly supplied as `env`") } new_quosure(parse_expr(x), as_environment(env)) } #' @rdname parse_expr #' @usage NULL #' @export parse_quos <- function(x, env) { if (missing(env)) { abort("The quosure environment should be explicitly supplied as `env`") } map(parse_exprs(x), new_quosure, env = as_environment(env)) } rlang/R/cnd-handlers.R0000644000176200001440000002265013241305652014251 0ustar liggesusers#' Establish handlers on the stack #' #' Condition handlers are functions established on the evaluation #' stack (see [ctxt_stack()]) that are called by R when a condition is #' signalled (see [cnd_signal()] and [abort()] for two common signal #' functions). They come in two types: exiting handlers, which jump #' out of the signalling context and are transferred to #' `with_handlers()` before being executed. And inplace handlers, #' which are executed within the signal functions. #' #' An exiting handler is taking charge of the condition. No other #' handler on the stack gets a chance to handle the condition. The #' handler is executed and `with_handlers()` returns the return value #' of that handler. On the other hand, in place handlers do not #' necessarily take charge. If they return normally, they decline to #' handle the condition, and R looks for other handlers established on #' the evaluation stack. Only by jumping to an earlier call frame can #' an inplace handler take charge of the condition and stop the #' signalling process. Sometimes, a muffling restart has been #' established for the purpose of jumping out of the signalling #' function but not out of the context where the condition was #' signalled, which allows execution to resume normally. See #' [rst_muffle()] the `muffle` argument of [inplace()] and the #' `mufflable` argument of [cnd_signal()]. #' #' Exiting handlers are established first by `with_handlers()`, and in #' place handlers are installed in second place. The latter handlers #' thus take precedence over the former. #' #' @inheritParams with_restarts #' @param .expr An expression to execute in a context where new #' handlers are established. The underscored version takes a quoted #' expression or a quoted formula. #' @param ... Named handlers. Handlers should inherit from `exiting` #' or `inplace`. See [exiting()] and [inplace()] for constructing #' such handlers. Dots are evaluated with [explicit #' splicing][tidy-dots]. #' @seealso [exiting()], [inplace()]. #' @export #' @examples #' # Signal a condition with cnd_signal(): #' fn <- function() { #' g() #' cat("called?\n") #' "fn() return value" #' } #' g <- function() { #' h() #' cat("called?\n") #' } #' h <- function() { #' cnd_signal("foo") #' cat("called?\n") #' } #' #' # Exiting handlers jump to with_handlers() before being #' # executed. Their return value is handed over: #' handler <- function(c) "handler return value" #' with_handlers(fn(), foo = exiting(handler)) #' #' # In place handlers are called in turn and their return value is #' # ignored. Returning just means they are declining to take charge of #' # the condition. However, they can produce side-effects such as #' # displaying a message: #' some_handler <- function(c) cat("some handler!\n") #' other_handler <- function(c) cat("other handler!\n") #' with_handlers(fn(), foo = inplace(some_handler), foo = inplace(other_handler)) #' #' # If an in place handler jumps to an earlier context, it takes #' # charge of the condition and no other handler gets a chance to #' # deal with it. The canonical way of transferring control is by #' # jumping to a restart. See with_restarts() and restarting() #' # documentation for more on this: #' exiting_handler <- function(c) rst_jump("rst_foo") #' fn2 <- function() { #' with_restarts(g(), rst_foo = function() "restart value") #' } #' with_handlers(fn2(), foo = inplace(exiting_handler), foo = inplace(other_handler)) with_handlers <- function(.expr, ...) { quo <- enquo(.expr) handlers <- dots_list(...) inplace <- keep(handlers, inherits, "inplace") exiting <- keep(handlers, inherits, "exiting") if (length(handlers) > length(exiting) + length(inplace)) { abort("all handlers should inherit from `exiting` or `inplace`") } if (length(exiting)) { quo <- quo(tryCatch(!! quo, !!! exiting)) } if (length(inplace)) { quo <- quo(withCallingHandlers(!! quo, !!! inplace)) } eval_tidy(quo) } #' Create an exiting or in place handler #' #' There are two types of condition handlers: exiting handlers, which #' are thrown to the place where they have been established (e.g., #' [with_handlers()]'s evaluation frame), and local handlers, which #' are executed in place (e.g., where the condition has been #' signalled). `exiting()` and `inplace()` create handlers suitable #' for [with_handlers()]. #' #' A subtle point in the R language is that conditions are not thrown, #' handlers are. [base::tryCatch()] and [with_handlers()] actually #' catch handlers rather than conditions. When a critical condition #' signalled with [base::stop()] or [abort()], R inspects the handler #' stack and looks for a handler that can deal with the condition. If #' it finds an exiting handler, it throws it to the function that #' established it ([with_handlers()]). That is, it interrupts the #' normal course of evaluation and jumps to `with_handlers()` #' evaluation frame (see [ctxt_stack()]), and only then and there the #' handler is called. On the other hand, if R finds an inplace #' handler, it executes it locally. The inplace handler can choose to #' handle the condition by jumping out of the frame (see [rst_jump()] #' or [return_from()]). If it returns locally, it declines to handle #' the condition which is passed to the next relevant handler on the #' stack. If no handler is found or is able to deal with the critical #' condition (by jumping out of the frame), R will then jump out of #' the faulty evaluation frame to top-level, via the abort restart #' (see [rst_abort()]). #' #' @param handler A handler function that takes a condition as #' argument. This is passed to [as_function()] and can thus be a #' formula describing a lambda function. #' @param muffle Whether to muffle the condition after executing an #' inplace handler. The signalling function must have established a #' muffling restart. Otherwise, an error will be issued. #' @seealso [with_handlers()] for examples, [restarting()] for another #' kind of inplace handler. #' @export #' @examples #' # You can supply a function taking a condition as argument: #' hnd <- exiting(function(c) cat("handled foo\n")) #' with_handlers(cnd_signal("foo"), foo = hnd) #' #' # Or a lambda-formula where "." is bound to the condition: #' with_handlers(foo = inplace(~cat("hello", .$attr, "\n")), { #' cnd_signal("foo", attr = "there") #' "foo" #' }) exiting <- function(handler) { handler <- as_function(handler) structure(handler, class = c("exiting", "handler")) } #' @rdname exiting #' @export inplace <- function(handler, muffle = FALSE) { handler <- as_function(handler) if (muffle) { handler_ <- function(c) { handler(c) rst_muffle(c) } } else { handler_ <- handler } structure(handler_, class = c("inplace", "handler")) } #' Create a restarting handler #' #' This constructor automates the common task of creating an #' [inplace()] handler that invokes a restart. #' #' Jumping to a restart point from an inplace handler has two #' effects. First, the control flow jumps to wherever the restart was #' established, and the restart function is called (with `...`, or #' `.fields` as arguments). Execution resumes from the #' [with_restarts()] call. Secondly, the transfer of the control flow #' out of the function that signalled the condition means that the #' handler has dealt with the condition. Thus the condition will not #' be passed on to other potential handlers established on the stack. #' #' @param .restart The name of a restart. #' @param .fields A character vector specifying the fields of the #' condition that should be passed as arguments to the restart. If #' named, the names (except empty names `""`) are used as #' argument names for calling the restart function. Otherwise the #' the fields themselves are used as argument names. #' @param ... Additional arguments passed on the restart #' function. These arguments are evaluated only once and #' immediately, when creating the restarting handler. Furthermore, #' they support [tidy dots][tidy-dots] features. #' @export #' @seealso [inplace()] and [exiting()]. #' @examples #' # This is a restart that takes a data frame and names as arguments #' rst_bar <- function(df, nms) { #' stats::setNames(df, nms) #' } #' #' # This restart is simpler and does not take arguments #' rst_baz <- function() "baz" #' #' # Signalling a condition parameterised with a data frame #' fn <- function() { #' with_restarts(cnd_signal("foo", foo_field = mtcars), #' rst_bar = rst_bar, #' rst_baz = rst_baz #' ) #' } #' #' # Creating a restarting handler that passes arguments `nms` and #' # `df`, the latter taken from a data field of the condition object #' restart_bar <- restarting("rst_bar", #' nms = LETTERS[1:11], .fields = c(df = "foo_field") #' ) #' #' # The restarting handlers jumps to `rst_bar` when `foo` is signalled: #' with_handlers(fn(), foo = restart_bar) #' #' # The restarting() constructor is especially nice to use with #' # restarts that do not need arguments: #' with_handlers(fn(), foo = restarting("rst_baz")) restarting <- function(.restart, ..., .fields = NULL) { stopifnot(is_scalar_character(.restart)) if (!is_null(.fields)) { .fields <- set_names2(.fields) stopifnot(is_character(.fields) && is_dictionaryish(.fields)) } args <- dots_list(...) handler <- function(c) { fields <- set_names(c[.fields], names(.fields)) rst_args <- c(fields, args) do.call("rst_jump", c(list(.restart = .restart), rst_args)) } structure(handler, class = c("restarting", "inplace", "handler")) } rlang/R/compat-purrr.R0000644000176200001440000001013013241233650014326 0ustar liggesusers# nocov start - compat-purrr (last updated: rlang 0.2.0) # This file serves as a reference for compatibility functions for # purrr. They are not drop-in replacements but allow a similar style # of programming. This is useful in cases where purrr is too heavy a # package to depend on. Please find the most recent version in rlang's # repository. map <- function(.x, .f, ...) { lapply(.x, .f, ...) } map_mold <- function(.x, .f, .mold, ...) { out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) names(out) <- names(.x) out } map_lgl <- function(.x, .f, ...) { map_mold(.x, .f, logical(1), ...) } map_int <- function(.x, .f, ...) { map_mold(.x, .f, integer(1), ...) } map_dbl <- function(.x, .f, ...) { map_mold(.x, .f, double(1), ...) } map_chr <- function(.x, .f, ...) { map_mold(.x, .f, character(1), ...) } map_cpl <- function(.x, .f, ...) { map_mold(.x, .f, complex(1), ...) } pluck <- function(.x, .f) { map(.x, `[[`, .f) } pluck_lgl <- function(.x, .f) { map_lgl(.x, `[[`, .f) } pluck_int <- function(.x, .f) { map_int(.x, `[[`, .f) } pluck_dbl <- function(.x, .f) { map_dbl(.x, `[[`, .f) } pluck_chr <- function(.x, .f) { map_chr(.x, `[[`, .f) } pluck_cpl <- function(.x, .f) { map_cpl(.x, `[[`, .f) } map2 <- function(.x, .y, .f, ...) { Map(.f, .x, .y, ...) } map2_lgl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "logical") } map2_int <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "integer") } map2_dbl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "double") } map2_chr <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "character") } map2_cpl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "complex") } args_recycle <- function(args) { lengths <- map_int(args, length) n <- max(lengths) stopifnot(all(lengths == 1L | lengths == n)) to_recycle <- lengths == 1L args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n)) args } pmap <- function(.l, .f, ...) { args <- args_recycle(.l) do.call("mapply", c( FUN = list(quote(.f)), args, MoreArgs = quote(list(...)), SIMPLIFY = FALSE, USE.NAMES = FALSE )) } probe <- function(.x, .p, ...) { if (is_logical(.p)) { stopifnot(length(.p) == length(.x)) .p } else { map_lgl(.x, .p, ...) } } keep <- function(.x, .f, ...) { .x[probe(.x, .f, ...)] } discard <- function(.x, .p, ...) { sel <- probe(.x, .p, ...) .x[is.na(sel) | !sel] } map_if <- function(.x, .p, .f, ...) { matches <- probe(.x, .p) .x[matches] <- map(.x[matches], .f, ...) .x } compact <- function(.x) { Filter(length, .x) } transpose <- function(.l) { inner_names <- names(.l[[1]]) if (is.null(inner_names)) { fields <- seq_along(.l[[1]]) } else { fields <- set_names(inner_names) } map(fields, function(i) { map(.l, .subset2, i) }) } every <- function(.x, .p, ...) { for (i in seq_along(.x)) { if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE) } TRUE } some <- function(.x, .p, ...) { for (i in seq_along(.x)) { if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE) } FALSE } negate <- function(.p) { function(...) !.p(...) } reduce <- function(.x, .f, ..., .init) { f <- function(x, y) .f(x, y, ...) Reduce(f, .x, init = .init) } reduce_right <- function(.x, .f, ..., .init) { f <- function(x, y) .f(y, x, ...) Reduce(f, .x, init = .init, right = TRUE) } accumulate <- function(.x, .f, ..., .init) { f <- function(x, y) .f(x, y, ...) Reduce(f, .x, init = .init, accumulate = TRUE) } accumulate_right <- function(.x, .f, ..., .init) { f <- function(x, y) .f(y, x, ...) Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE) } detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) { for (i in index(.x, .right)) { if (.p(.f(.x[[i]], ...))) { return(.x[[i]]) } } NULL } detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) { for (i in index(.x, .right)) { if (.p(.f(.x[[i]], ...))) { return(i) } } 0L } index <- function(x, right = FALSE) { idx <- seq_along(x) if (right) { idx <- rev(idx) } idx } # nocov end rlang/R/compat-oldrel.R0000644000176200001440000000205313241233650014442 0ustar liggesusers# nocov start - compat-oldrel (last updated: rlang 0.1.2) # This file serves as a reference for compatibility functions for old # versions of R. Please find the most recent version in rlang's # repository. # R 3.2.0 ------------------------------------------------------------ if (getRversion() < "3.2.0") { dir_exists <- function(path) { !identical(path, "") && file.exists(paste0(path, .Platform$file.sep)) } dir.exists <- function(paths) { vapply(paths, dir_exists, logical(1)) } names <- function(x) { if (is.environment(x)) { return(ls(x, all.names = TRUE)) } else { return(base::names(x)) } # So R CMD check on old versions of R sees a generic, since we # declare a names() method for dictionary objects UseMethod("names") } trimws <- function(x, which = c("both", "left", "right")) { switch(match.arg(which), left = sub("^[ \t\r\n]+", "", x, perl = TRUE), right = sub("[ \t\r\n]+$", "", x, perl = TRUE), both = trimws(trimws(x, "left"), "right") ) } } # nocov end rlang/R/vec-na.R0000644000176200001440000000663513241233650013063 0ustar liggesusers#' Missing values #' #' Missing values are represented in R with the general symbol #' `NA`. They can be inserted in almost all data containers: all #' atomic vectors except raw vectors can contain missing values. To #' achieve this, R automatically converts the general `NA` symbol to a #' typed missing value appropriate for the target vector. The objects #' provided here are aliases for those typed `NA` objects. #' #' Typed missing values are necessary because R needs sentinel values #' of the same type (i.e. the same machine representation of the data) #' as the containers into which they are inserted. The official typed #' missing values are `NA_integer_`, `NA_real_`, `NA_character_` and #' `NA_complex_`. The missing value for logical vectors is simply the #' default `NA`. The aliases provided in rlang are consistently named #' and thus simpler to remember. Also, `na_lgl` is provided as an #' alias to `NA` that makes intent clearer. #' #' Since `na_lgl` is the default `NA`, expressions such as `c(NA, NA)` #' yield logical vectors as no data is available to give a clue of the #' target type. In the same way, since lists and environments can #' contain any types, expressions like `list(NA)` store a logical #' `NA`. #' #' @seealso The [new-vector-along] family to create typed vectors filled #' with missing values. #' @examples #' typeof(NA) #' typeof(na_lgl) #' typeof(na_int) #' #' # Note that while the base R missing symbols cannot be overwritten, #' # that's not the case for rlang's aliases: #' na_dbl <- NA #' typeof(na_dbl) #' @name missing NULL #' @rdname missing #' @export na_lgl <- NA #' @rdname missing #' @export na_int <- NA_integer_ #' @rdname missing #' @export na_dbl <- NA_real_ #' @rdname missing #' @export na_chr <- NA_character_ #' @rdname missing #' @export na_cpl <- NA_complex_ #' Test for missing values #' #' `are_na()` checks for missing values in a vector and is equivalent #' to [base::is.na()]. It is a vectorised predicate, meaning that its #' output is always the same length as its input. On the other hand, #' `is_na()` is a scalar predicate and always returns a scalar #' boolean, `TRUE` or `FALSE`. If its input is not scalar, it returns #' `FALSE`. Finally, there are typed versions that check for #' particular [missing types][missing]. #' #' The scalar predicates accept non-vector inputs. They are equivalent #' to [is_null()] in that respect. In contrast the vectorised #' predicate `are_na()` requires a vector input since it is defined #' over vector values. #' #' @param x An object to test #' @export #' @examples #' # are_na() is vectorised and works regardless of the type #' are_na(c(1, 2, NA)) #' are_na(c(1L, NA, 3L)) #' #' # is_na() checks for scalar input and works for all types #' is_na(NA) #' is_na(na_dbl) #' is_na(character(0)) #' #' # There are typed versions as well: #' is_lgl_na(NA) #' is_lgl_na(na_dbl) are_na <- function(x) { if (!is_vector(x)) { abort("`x` must be a vector") } is.na(x) } #' @rdname are_na #' @export is_na <- function(x) { is_scalar_vector(x) && is.na(x) } #' @rdname are_na #' @export is_lgl_na <- function(x) { identical(x, na_lgl) } #' @rdname are_na #' @export is_int_na <- function(x) { identical(x, na_int) } #' @rdname are_na #' @export is_dbl_na <- function(x) { identical(x, na_dbl) } #' @rdname are_na #' @export is_chr_na <- function(x) { identical(x, na_chr) } #' @rdname are_na #' @export is_cpl_na <- function(x) { identical(x, na_cpl) } rlang/R/stack.R0000644000176200001440000004715513241233650013021 0ustar liggesusers#' Get the environment of the caller frame #' #' @param n The number of generation to go back. #' @export caller_env <- function(n = 1) { parent.frame(n + 1) } #' @rdname caller_env #' @export caller_frame <- function(n = 1) { call_frame(n + 2) } #' @rdname caller_env #' @export caller_fn <- function(n = 1) { call_frame(n + 2)$fn } #' Call stack information #' #' The `eval_` and `call_` families of functions provide a replacement #' for the base R functions prefixed with `sys.` (which are all about #' the context stack), as well as for [parent.frame()] (which is the #' only base R function for querying the call stack). The context #' stack includes all R-level evaluation contexts. It is linear in #' terms of execution history but due to lazy evaluation it is #' potentially nonlinear in terms of call history. The call stack #' history, on the other hand, is homogenous. #' #' `ctxt_frame()` and `call_frame()` return a `frame` object #' containing the following fields: `expr` and `env` (call expression #' and evaluation environment), `pos` and `caller_pos` (position of #' current frame in the context stack and position of the caller), and #' `fun` (function of the current frame). `ctxt_stack()` and #' `call_stack()` return a list of all context or call frames on the #' stack. Finally, `ctxt_depth()` and `call_depth()` report the #' current context position or the number of calling frames on the #' stack. #' #' The base R functions take two sorts of arguments to indicate which #' frame to query: `which` and `n`. The `n` argument is #' straightforward: it's the number of frames to go down the stack, #' with `n = 1` referring to the current context. The `which` argument #' is more complicated and changes meaning for values lower than 1. #' For the sake of consistency, the lazyeval functions all take the #' same kind of argument `n`. This argument has a single meaning (the #' number of frames to go down the stack) and cannot be lower than 1. #' #' Note finally that `parent.frame(1)` corresponds to #' `call_frame(2)$env`, as `n = 1` always refers to the current #' frame. This makes the `_frame()` and `_stack()` functions #' consistent: `ctxt_frame(2)` is the same as `ctxt_stack()[[2]]`. #' Also, `ctxt_depth()` returns one more frame than #' [base::sys.nframe()] because it counts the global frame. That is #' consistent with the `_stack()` functions which return the global #' frame as well. This way, `call_stack(call_depth())` is the same as #' `global_frame()`. #' #' #' @section Life cycle: #' #' These functions are in the questioning stage. We are no longer #' convinced they belong in rlang as they are mostly for REPL #' interaction and runtime inspection rather than function #' development. #' #' @param n The number of frames to go back in the stack. #' @param clean Whether to post-process the call stack to clean #' non-standard frames. If `TRUE`, suboptimal call-stack entries by #' [base::eval()] will be cleaned up: the duplicate frame created by #' `eval()` is eliminated. #' @param trim The number of layers of intervening frames to trim off #' the stack. See [stack_trim()] and examples. #' @name stack #' @keywords internal #' @examples #' # Expressions within arguments count as contexts #' identity(identity(ctxt_depth())) # returns 2 #' #' # But they are not part of the call stack because arguments are #' # evaluated within the calling function (or the global environment #' # if called at top level) #' identity(identity(call_depth())) # returns 0 #' #' # The context stacks includes all intervening execution frames. The #' # call stack doesn't: #' f <- function(x) identity(x) #' f(f(ctxt_stack())) #' f(f(call_stack())) #' #' g <- function(cmd) cmd() #' f(g(ctxt_stack)) #' f(g(call_stack)) #' #' # The lazyeval _stack() functions return a list of frame #' # objects. Use purrr::transpose() or index a field with #' # purrr::map()'s to extract a particular field from a stack: #' #' # stack <- f(f(call_stack())) #' # purrr::map(stack, "env") #' # purrr::transpose(stack)$expr #' #' # current_frame() is an alias for ctxt_frame(1) #' fn <- function() list(current = current_frame(), first = ctxt_frame(1)) #' fn() #' #' # While current_frame() is the top of the stack, global_frame() is #' # the bottom: #' fn <- function() { #' n <- ctxt_depth() #' ctxt_frame(n) #' } #' identical(fn(), global_frame()) #' #' #' # ctxt_stack() returns a stack with all intervening frames. You can #' # trim layers of intervening frames with the trim argument: #' identity(identity(ctxt_stack())) #' identity(identity(ctxt_stack(trim = 1))) #' #' # ctxt_stack() is called within fn() with intervening frames: #' fn <- function(trim) identity(identity(ctxt_stack(trim = trim))) #' fn(0) #' #' # We can trim the first layer of those: #' fn(1) #' #' # The outside intervening frames (at the fn() call site) are still #' # returned, but can be trimmed as well: #' identity(identity(fn(1))) #' identity(identity(fn(2))) #' #' g <- function(trim) identity(identity(fn(trim))) #' g(2) #' g(3) NULL # Evaluation frames -------------------------------------------------- new_frame <- function(x) { structure(x, class = "frame") } #' @export print.frame <- function(x, ...) { cat("", sep = "") if (!x$pos) { cat(" [global]\n") } else { cat(" (", x$caller_pos, ")\n", sep = "") } expr <- deparse(x$expr) if (length(expr) > 1) { expr <- paste(expr[[1]], "<...>") } cat("expr: ", expr, "\n", sep = "") cat("env: [", env_format(x$env), "]\n", sep = "") } #' Is object a frame? #' #' @param x Object to test #' @export is_frame <- function(x) { inherits(x, "frame") } #' @rdname stack #' @export global_frame <- function() { new_frame(list( pos = 0L, caller_pos = NA_integer_, expr = NULL, env = globalenv(), fn = NULL, fn_name = NULL )) } #' @rdname stack #' @export current_frame <- function() { ctxt_frame(2) } #' @rdname stack #' @export ctxt_frame <- function(n = 1) { stopifnot(n > 0) pos <- sys.nframe() - n if (pos < 0L) { stop("not that many frames on the stack", call. = FALSE) } else if (pos == 0L) { global_frame() } else { new_frame(list( pos = pos, caller_pos = sys.parent(n + 1), expr = sys.call(-n), env = sys.frame(-n), fn = sys.function(-n), fn_name = call_name(sys.call(-n)) )) } } # Positions of frames in the call stack up to `n` trail_make <- function(callers, n = NULL, clean = TRUE) { n_ctxt <- length(callers) if (is.null(n)) { n_max <- n_ctxt } else { if (n > n_ctxt) { stop("not that many frames on the evaluation stack", call. = FALSE) } n_max <- n + 1 } state <- trail_next(callers, 1, clean) if (!length(state$i) || state$i == 0) { return(0L) } j <- 1 # Preallocate a sufficiently large vector out <- integer(n_max) out[j] <- state$i while (state$i != 0 && j < n_max) { j <- j + 1 n_ctxt <- length(state$callers) next_pos <- n_ctxt - state$i + 1 state <- trail_next(state$callers, next_pos, clean) out[j] <- state$i } # Return relevant subset if (!is.null(n) && n > j) { stop("not that many frames on the call stack", call. = FALSE) } out[seq_len(j)] } trail_next <- function(callers, i, clean) { if (i == 0L) { return(list(callers = callers, i = 0L)) } i <- callers[i] if (clean) { # base::Recall() creates a custom context with the wrong sys.parent() if (identical(sys.function(i - 1L), base::Recall)) { i_pos <- trail_index(callers, i) callers[i_pos] <- i - 1L } # The R-level eval() creates two contexts. We skip the second one if (length(i) && is_prim_eval(sys.function(i))) { n_ctxt <- length(callers) special_eval_pos <- trail_index(callers, i) callers <- callers[-special_eval_pos] i <- i - 1L } } list(callers = callers, i = i) } trail_index <- function(callers, i) { n_ctxt <- length(callers) n_ctxt - i + 1L } #' @rdname stack #' @export call_frame <- function(n = 1, clean = TRUE) { stopifnot(n > 0) eval_callers <- ctxt_stack_callers() trail <- trail_make(eval_callers, n, clean = clean) pos <- trail[n] if (identical(pos, 0L)) { return(global_frame()) } frame <- new_frame(list( pos = pos, caller_pos = trail[n + 1], expr = sys.call(pos), env = sys.frame(pos), fn = sys.function(pos), fn_name = call_name(sys.call(pos)) )) if (clean) { frame <- frame_clean_eval(frame) } frame } # The _depth() functions count the global frame as well #' @rdname stack #' @export ctxt_depth <- function() { sys.nframe() } #' @rdname stack #' @export call_depth <- function() { eval_callers <- ctxt_stack_callers() trail <- trail_make(eval_callers) length(trail) } # Summaries ---------------------------------------------------------- #' @rdname stack #' @export ctxt_stack <- function(n = NULL, trim = 0) { stack_data <- list( pos = ctxt_stack_trail(), caller_pos = ctxt_stack_callers(), expr = ctxt_stack_exprs(), env = ctxt_stack_envs(), fn = ctxt_stack_fns() ) # Remove ctxt_stack() from stack stack_data <- map(stack_data, drop_first) stack_data <- stack_subset(stack_data, n) stack_data$fn_name <- map(stack_data$expr, call_name) stack <- transpose(stack_data) stack <- map(stack, new_frame) if (is.null(n) || (length(n) && n > length(stack))) { stack <- c(stack, list(global_frame())) } if (trim > 0) { stack <- stack_trim(stack, n = trim + 1) } structure(stack, class = c("ctxt_stack", "stack")) } ctxt_stack_trail <- function() { pos <- sys.nframe() - 1 seq(pos, 1) } ctxt_stack_exprs <- function() { exprs <- sys.calls() rev(drop_last(exprs)) } ctxt_stack_envs <- function(n = 1) { envs <- sys.frames() rev(drop_last(envs)) } ctxt_stack_callers <- function() { callers <- sys.parents() rev(drop_last(callers)) } ctxt_stack_fns <- function() { pos <- sys.nframe() - 1 map(seq(pos, 1), sys.function) } stack_subset <- function(stack_data, n) { if (length(n)) { stopifnot(n > 0) n_stack <- length(stack_data[[1]]) if (n == n_stack + 1) { # We'll add the global frame later n <- n <- n - 1 } else if (n > n_stack + 1) { stop("not that many frames on the stack", call. = FALSE) } stack_data <- map(stack_data, `[`, seq_len(n)) } stack_data } #' @rdname stack #' @export call_stack <- function(n = NULL, clean = TRUE) { eval_callers <- ctxt_stack_callers() trail <- trail_make(eval_callers, n, clean = clean) stack_data <- list( pos = drop_last(trail), caller_pos = drop_first(trail), expr = map(trail, sys.call), env = map(trail, sys.frame), fn = map(trail, sys.function) ) stack_data$fn_name <- map(stack_data$expr, call_name) stack <- transpose(stack_data) stack <- map(stack, new_frame) if (clean) { stack <- map(stack, frame_clean_eval) } if (trail[length(trail)] == 0L) { stack <- c(stack, list(global_frame())) } structure(stack, class = c("call_stack", "stack")) } frame_clean_eval <- function(frame) { if (identical(frame$fn, base::eval)) { # Use the environment from the context created in do_eval() # (the context with the fake primitive call) stopifnot(is_prim_eval(sys.function(frame$pos + 1))) frame$env <- sys.frame(frame$pos + 1) } frame } #' Is object a stack? #' @param x An object to test #' @export is_stack <- function(x) inherits(x, "stack") #' @rdname is_stack #' @export is_eval_stack <- function(x) inherits(x, "ctxt_stack") #' @rdname is_stack #' @export is_call_stack <- function(x) inherits(x, "call_stack") #' @export `[.stack` <- function(x, i) { structure(NextMethod(), class = class(x)) } # Handles global_frame() whose `caller_pos` is NA sys_frame <- function(n) { if (is.na(n)) { NULL } else { sys.frame(n) } } #' Find the position or distance of a frame on the evaluation stack #' #' The frame position on the stack can be computed by counting frames #' from the global frame (the bottom of the stack, the default) or #' from the current frame (the top of the stack). #' #' While this function returns the position of the frame on the #' evaluation stack, it can safely be called with intervening frames #' as those will be discarded. #' #' #' @section Life cycle: #' #' These functions are in the questioning stage. We are no longer #' convinced they belong in rlang as they are mostly for REPL #' interaction and runtime inspection rather than function #' development. #' #' @param frame The environment of a frame. Can be any object with a #' [get_env()] method. Note that for frame objects, the position from #' the global frame is simply `frame$pos`. Alternatively, `frame` #' can be an integer that represents the position on the stack (and #' is thus returned as is if `from` is "global". #' @param from Whether to compute distance from the global frame (the #' bottom of the evaluation stack), or from the current frame (the #' top of the evaluation stack). #' #' @keywords internal #' @export #' @examples #' fn <- function() g(environment()) #' g <- function(env) frame_position(env) #' #' # frame_position() returns the position of the frame on the evaluation stack: #' fn() #' identity(identity(fn())) #' #' # Note that it trims off intervening calls before counting so you #' # can safely nest it within other calls: #' g <- function(env) identity(identity(frame_position(env))) #' fn() #' #' # You can also ask for the position from the current frame rather #' # than the global frame: #' fn <- function() g(environment()) #' g <- function(env) h(env) #' h <- function(env) frame_position(env, from = "current") #' fn() frame_position <- function(frame, from = c("global", "current")) { stack <- stack_trim(ctxt_stack(), n = 2) if (arg_match(from) == "global") { frame_position_global(frame, stack) } else { caller_pos <- call_frame(2)$pos frame_position_current(frame, stack, caller_pos) } } frame_position_global <- function(frame, stack = NULL) { if (is_frame(frame)) { return(frame$pos) } else if (is_integerish(frame)) { return(frame) } frame <- get_env(frame) stack <- stack %||% stack_trim(ctxt_stack(), n = 2) envs <- pluck(stack, "env") i <- 1 for (env in envs) { if (identical(env, frame)) { return(length(envs) - i) } i <- i + 1 } abort("`frame` not found on evaluation stack") } frame_position_current <- function(frame, stack = NULL, caller_pos = NULL) { if (is_integerish(frame)) { pos <- frame } else { stack <- stack %||% stack_trim(ctxt_stack(), n = 2) pos <- frame_position_global(frame, stack) } caller_pos <- caller_pos %||% call_frame(2)$pos caller_pos - pos + 1 } #' Trim top call layers from the evaluation stack #' #' [ctxt_stack()] can be tricky to use in real code because all #' intervening frames are returned with the stack, including those at #' `ctxt_stack()` own call site. `stack_trim()` makes it easy to #' remove layers of intervening calls. #' #' #' @section Life cycle: #' #' These functions are in the questioning stage. We are no longer #' convinced they belong in rlang as they are mostly for REPL #' interaction and runtime inspection rather than function #' development. #' #' @param stack An evaluation stack. #' @param n The number of call frames (not eval frames) to trim off #' the top of the stack. In other words, the number of layers of #' intervening frames to trim. #' @export #' @keywords internal #' @examples #' # Intervening frames appear on the evaluation stack: #' identity(identity(ctxt_stack())) #' #' # stack_trim() will trim the first n layers of calls: #' stack_trim(identity(identity(ctxt_stack()))) #' #' # Note that it also takes care of calls intervening at its own call #' # site: #' identity(identity( #' stack_trim(identity(identity(ctxt_stack()))) #' )) #' #' # It is especially useful when used within a function that needs to #' # inspect the evaluation stack but should nonetheless be callable #' # within nested calls without side effects: #' stack_util <- function() { #' # n = 2 means that two layers of intervening calls should be #' # removed: The layer at ctxt_stack()'s call site (including the #' # stack_trim() call), and the layer at stack_util()'s call. #' stack <- stack_trim(ctxt_stack(), n = 2) #' stack #' } #' user_fn <- function() { #' # A user calls your stack utility with intervening frames: #' identity(identity(stack_util())) #' } #' # These intervening frames won't appear in the evaluation stack #' identity(user_fn()) stack_trim <- function(stack, n = 1) { if (n < 1) { return(stack) } # Add 1 to discard stack_trim()'s own intervening frames caller_pos <- call_frame(n + 1, clean = FALSE)$pos n_frames <- length(stack) n_skip <- n_frames - caller_pos stack[seq(n_skip, n_frames)] } is_frame_env <- function(env) { for (frame in sys.frames()) { if (identical(env, frame)) { return(TRUE) } } FALSE } #' Jump to or from a frame #' #' While [base::return()] can only return from the current local #' frame, these two functions will return from any frame on the #' current evaluation stack, between the global and the currently #' active context. They provide a way of performing arbitrary #' non-local jumps out of the function currently under evaluation. #' #' `return_from()` will jump out of `frame`. `return_to()` is a bit #' trickier. It will jump out of the frame located just before `frame` #' in the evaluation stack, so that control flow ends up in `frame`, #' at the location where the previous frame was called from. #' #' These functions should only be used rarely. These sort of non-local #' gotos can be hard to reason about in casual code, though they can #' sometimes be useful. Also, consider to use the condition system to #' perform non-local jumps. #' #' #' @section Life cycle: #' #' The support for `frame` object is experimental. The stack and frame #' objects are likely to be moved from rlang to another package. #' Please pass simple environments to `return_from()` and `return_to()`. #' #' @param frame An environment, a frame object, or any object with an #' [get_env()] method. The environment should be an evaluation #' environment currently on the stack. #' @param value The return value. #' @export #' @examples #' # Passing fn() evaluation frame to g(): #' fn <- function() { #' val <- g(get_env()) #' cat("g returned:", val, "\n") #' "normal return" #' } #' g <- function(env) h(env) #' #' # Here we return from fn() with a new return value: #' h <- function(env) return_from(env, "early return") #' fn() #' #' # Here we return to fn(). The call stack unwinds until the last frame #' # called by fn(), which is g() in that case. #' h <- function(env) return_to(env, "early return") #' fn() return_from <- function(frame, value = NULL) { if (is_integerish(frame)) { frame <- ctxt_frame(frame) } exit_env <- get_env(frame) expr <- expr(return(!!value)) eval_bare(expr, exit_env) } #' @rdname return_from #' @export return_to <- function(frame, value = NULL) { if (is_integerish(frame)) { prev_pos <- frame - 1 } else { env <- get_env(frame) distance <- frame_position_current(env) prev_pos <- distance - 1 } prev_frame <- ctxt_frame(prev_pos) return_from(prev_frame, value) } #' Inspect a call #' #' This function is useful for quick testing and debugging when you #' manipulate expressions and calls. It lets you check that a function #' is called with the right arguments. This can be useful in unit #' tests for instance. Note that this is just a simple wrapper around #' [base::match.call()]. #' #' @param ... Arguments to display in the returned call. #' @export #' @examples #' call_inspect(foo(bar), "" %>% identity()) #' invoke(call_inspect, list(a = mtcars, b = letters)) call_inspect <- function(...) match.call() rlang/R/lifecycle-retired.R0000644000176200001440000003260613241233650015302 0ustar liggesusers signal_soft_deprecation <- function(msg) { if (is_true(peek_option("lifecycle_force_verbose_retirement"))) { warn(msg) } invisible(NULL) } # Soft-deprecated ---------------------------------------------------- #' Parse text into a quosure #' #' These functions were soft-deprecated and renamed to [parse_quo()] #' and [parse_quos()] in rlang 0.2.0. This is for consistency with the #' convention that suffixes indicating return types are not #' abbreviated. #' #' @inheritParams parse_expr #' @keywords internal #' @export parse_quosure <- function(x, env = caller_env()) { signal_soft_deprecation( "`parse_quosure()` is soft-deprecated as of rlang 0.2.0. Please use `parse_quo()` instead." ) parse_quo(x, env = env) } #' @rdname parse_expr #' @export parse_quosures <- function(x, env = caller_env()) { signal_soft_deprecation( "`parse_quosures()` is soft-deprecated as of rlang 0.2.0. Please use `parse_quos()` instead." ) parse_quos(x, env = env) } #' Squash a quosure #' #' This function is soft-deprecated, please use [quo_squash()] instead. #' #' @inheritParams quo_squash #' @keywords internal #' @export quo_expr <- function(quo, warn = FALSE) { quo_squash(quo, warn = warn) } #' Create a call #' #' This function is soft-deprecated, please use [call2()] instead. #' #' @inheritParams call2 #' @keywords internal #' @export lang <- function(.fn, ..., .ns = NULL) { call2(.fn, ..., .ns = .ns) } #' @rdname lang #' @inheritParams new_call #' @export new_language <- function(head, tail = NULL) { new_call(head, tail) } #' Is object a call? #' #' These functions are soft-deprecated, please use [is_call()] and its #' `n` argument instead. #' #' @inheritParams is_call #' @keywords internal #' @export is_lang <- function(x, name = NULL, n = NULL, ns = NULL) { is_call(x, name, n, ns) } #' @rdname is_lang #' @export is_unary_lang <- function(x, name = NULL, ns = NULL) { is_call(x, name, n = 1L, ns = ns) } #' @rdname is_lang #' @export is_binary_lang <- function(x, name = NULL, ns = NULL) { is_call(x, name, n = 2L, ns = ns) } #' @rdname is_lang #' @param quo A quosure to test. #' @export quo_is_lang <- function(quo) { .Call(rlang_quo_is_call, quo) } #' Manipulate or access a call #' #' These functions are soft-deprecated, please use [call_modify()], #' [call_standardise()], or [call_fn()] instead. #' #' @inheritParams call_modify #' @param lang,.lang The `call` or `.call` argument of the renamed #' functions. #' @keywords internal #' @export lang_modify <- function(.lang, ..., .standardise = FALSE) { call_modify(.lang, ..., .standardise = .standardise, .env = caller_env()) } #' @rdname lang_modify #' @export lang_standardise <- function(lang) { call_standardise(lang, env = caller_env()) } #' @rdname lang_modify #' @export lang_fn <- function(lang) { call_fn(lang, caller_env()) } #' @rdname lang_modify #' @export lang_name <- function(lang) { call_name(lang) } #' @rdname lang_modify #' @export lang_args <- function(lang) { call_args(lang) } #' @rdname lang_modify #' @export lang_args_names <- function(lang) { call_args_names(lang) } #' Return the head or tail of a call #' #' As of rlang 0.2.0 these functions are retired (soft-deprecated for #' now) because they are low level accessors that are rarely needed #' for end users. #' #' @param lang A call. #' @export lang_head <- function(lang) { call <- get_expr(lang) stopifnot(is_call(call)) node_car(call) } #' @rdname lang_head #' @export lang_tail <- function(lang) { call <- get_expr(lang) stopifnot(is_call(call)) node_cdr(call) } #' Create an overscope #' #' These functions have been soft-deprecated in rlang 0.2.0. Please #' use [as_data_mask()] and [new_data_mask()] instead. We no longer #' require the mask to be cleaned up so `overscope_clean()` does not #' have a replacement. #' #' @inheritParams as_data_mask #' @param quo A [quosure][quotation]. #' #' @keywords internal #' @export as_overscope <- function(quo, data = NULL) { as_data_mask(data, quo_get_env(quo)) } #' @rdname as_overscope #' @param enclosure The `parent` argument of [new_data_mask()]. #' @export new_overscope <- function(bottom, top = NULL, enclosure = base_env()) { new_data_mask(bottom, top, enclosure) } #' @rdname as_overscope #' @param overscope A data mask. #' @export overscope_clean <- function(overscope) { invisible(.Call(rlang_data_mask_clean, overscope)) } #' Tidy evaluation in a custom environment #' #' This function is soft-deprecated as of rlang 0.2.0. #' #' @inheritParams eval_tidy #' @inheritParams as_data_mask #' #' @keywords internal #' @export eval_tidy_ <- function(expr, bottom, top = NULL, env = caller_env()) { data_mask <- new_overscope(bottom, top %||% bottom) on.exit(overscope_clean(data_mask)) .Call(rlang_eval_tidy, expr, data_mask, environment()) } #' Evaluate next quosure in a data mask #' #' `overscope_eval_next()` is soft-deprecated as of rlang #' 0.2.0. Please use `eval_tidy()` to which you can now supply an #' overscope. #' #' @param quo A quosure. #' @param overscope A valid overscope containing bindings for `~`, #' `.top_env` and `_F` and whose parents contain overscoped bindings #' for tidy evaluation. #' @param env The lexical enclosure in case `quo` is not a validly #' scoped quosure. This is the [base environment][base_env] by #' default. #' #' @keywords internal #' @export overscope_eval_next <- function(overscope, quo, env = base_env()) { .Call(rlang_eval_tidy, quo, overscope, environment()) } #' Create a dictionary #' #' The dictionary class was soft-deprecated in rlang 0.2.0. It was #' trying to be too general and did not prove useful. Please use #' [as_data_pronoun()] or your own pronoun class instead. #' #' @param x An object for which you want to find associated data. #' @param lookup_msg An error message when your data source is #' accessed inappropriately (by position rather than name). #' @param read_only Whether users can replace elements of the #' dictionary. #' #' @name dictionary #' @keywords internal #' @export as_dictionary <- function(x, lookup_msg = NULL, read_only = FALSE) { UseMethod("as_dictionary") } #' @export as_dictionary.default <- function(x, lookup_msg = NULL, read_only = FALSE) { x <- discard_unnamed(x) check_dictionaryish(x) new_dictionary(as.list(x), lookup_msg, read_only) } #' @export as_dictionary.dictionary <- function(x, lookup_msg = NULL, read_only = FALSE) { dict <- unclass_data_pronoun(x) dict$lookup_msg <- lookup_msg %||% x$lookup_msg dict$read_only <- read_only set_attrs(dict, class = class(x)) } #' @export as_dictionary.NULL <- function(x, lookup_msg = NULL, read_only = FALSE) { new_dictionary(list(), lookup_msg, read_only) } #' @export as_dictionary.environment <- function(x, lookup_msg = NULL, read_only = FALSE) { lookup_msg <- lookup_msg %||% "Object `%s` not found in environment" new_dictionary(x, lookup_msg, read_only) } #' @export as_dictionary.data.frame <- function(x, lookup_msg = NULL, read_only = FALSE) { check_dictionaryish(x) lookup_msg <- lookup_msg %||% "Column `%s` not found in data" new_dictionary(x, lookup_msg, read_only) } check_dictionaryish <- function(x) { if (!length(x)) { return(NULL) } if (!is_named(x)) { abort("Data must be uniquely named but some variables are unnamed") } nms <- names(x) dups <- duplicated(nms) if (any(dups)) { dups <- unique(nms[dups]) dups <- chr_enumerate(chr_quoted(dups), final = "and") abort(paste0( "Data must be uniquely named but the following variables have duplicates: ", dups )) } } new_dictionary <- function(x, lookup_msg, read_only) { .Call(rlang_new_data_pronoun, x, lookup_msg, read_only) } #' @rdname dictionary #' @export is_dictionary <- function(x) { inherits(x, "rlang_data_pronoun") } #' Coerce to an environment #' #' This function is soft-deprecated as it was renamed to #' [as_environment()] in rlang 0.2.0. #' #' @keywords internal #' @export as_env <- function(x, parent = NULL) { as_environment(x, parent) } #' Mutate node components #' #' These functions were soft-deprecated and renamed with `node_poke_` #' prefix in rlang 0.2.0. This change follows a new naming convention #' where mutation is referred to as "poking". #' #' @inheritParams new_node #' #' @keywords internal #' @export mut_node_car <- function(x, newcar) { invisible(.Call(rlang_node_poke_car, x, newcar)) } #' @rdname mut_node_car #' @export mut_node_cdr <- function(x, newcdr) { invisible(.Call(rlang_node_poke_cdr, x, newcdr)) } #' @rdname mut_node_car #' @export mut_node_caar <- function(x, newcar) { invisible(.Call(rlang_node_poke_caar, x, newcar)) } #' @rdname mut_node_car #' @export mut_node_cadr <- function(x, newcar) { invisible(.Call(rlang_node_poke_cadr, x, newcar)) } #' @rdname mut_node_car #' @export mut_node_cdar <- function(x, newcdr) { invisible(.Call(rlang_node_poke_cdar, x, newcdr)) } #' @rdname mut_node_car #' @export mut_node_cddr <- function(x, newcdr) { invisible(.Call(rlang_node_poke_cddr, x, newcdr)) } #' @rdname mut_node_car #' @export mut_node_tag <- function(x, newtag) { invisible(.Call(rlang_node_poke_tag, x, newtag)) } #' Is an object an expression? #' #' This function was soft-deprecated and renamed to [is_expression()] #' in rlang 0.2.0. This is for consistency with other type predicates #' which are not abbreviated. #' #' @inheritParams is_expression #' @keywords internal #' @export is_expr <- function(x) { is_expression(x) } # Deprecated --------------------------------------------------------- #' Test for or coerce to quosure-like objects #' #' These functions are deprecated as of rlang 0.2.0 because they make #' the assumption that quosures are a subtype of formula, which we are #' now considering to be an implementation detail. #' #' @inheritParams is_formula #' @inheritParams as_quosure #' #' @keywords internal #' @export is_quosureish <- function(x, scoped = NULL) { warn("`is_quosureish()` is deprecated as of rlang 0.2.0") is_formula(x, scoped = scoped, lhs = FALSE) } #' @rdname is_quosureish #' @export as_quosureish <- function(x, env = caller_env()) { warn("`as_quosureish()` is deprecated as of rlang 0.2.0") if (is_quosureish(x)) { if (!is_environment(get_env(x))) { set_env(x, env) } x } else if (is_frame(x)) { new_quosure(x$expr, sys_frame(x$caller_pos)) } else { new_quosure(get_expr(x), get_env(x, env)) } } #' Deprecated condition constructors #' #' These functions were deprecated in rlang 0.2.0 to follow the #' convention that return types are indicated as suffixes. Please use #' [cnd()], [error_cnd()], [warning_cnd()] and [message_cnd()] #' instead. #' #' @inheritParams cnd #' @name deprecated-cnd #' @keywords internal #' @export new_cnd <- function(.type = NULL, ..., .msg = NULL) { # Deprecated in 0.1.2 warning("`new_cnd()` has been renamed to `cnd()` for consistency", call. = FALSE) cnd(.type = .type, ..., .msg = .msg) } #' @rdname deprecated-cnd #' @export cnd_error <- function(.type = NULL, ..., .msg = NULL) { # Deprecated in 0.1.2 warning("`cnd_error()` has been renamed to `error_cnd()` for consistency", call. = FALSE) error_cnd(.type = .type, ..., .msg = .msg) } #' @rdname deprecated-cnd #' @export cnd_warning <- function(.type = NULL, ..., .msg = NULL) { # Deprecated in 0.1.2 warning("`cnd_warning()` has been renamed to `warning_cnd()` for consistency", call. = FALSE) warning_cnd(.type = .type, ..., .msg = .msg) } #' @rdname deprecated-cnd #' @export cnd_message <- function(.type = NULL, ..., .msg = NULL) { # Deprecated in 0.1.2 warning("`cnd_message()` has been renamed to `message_cnd()` for consistency", call. = FALSE) message_cnd(.type = .type, ..., .msg = .msg) } #' Retired vector construction by length #' #' These functions were soft-deprecated and renamed with `new_` prefix #' in rlang 0.2.0. This is for consistency with other non-variadic #' object constructors. #' #' @inheritParams new-vector #' @inheritParams new-vector-along #' @name vector-old-ctors #' @keywords internal NULL #' @rdname vector-old-ctors #' @export lgl_len <- function(.n) { new_logical(.n) } #' @rdname vector-old-ctors #' @export int_len <- function(.n) { new_integer(.n) } #' @rdname vector-old-ctors #' @export dbl_len <- function(.n) { new_double(.n) } #' @rdname vector-old-ctors #' @export chr_len <- function(.n) { new_character(.n) } #' @rdname vector-old-ctors #' @export cpl_len <- function(.n) { new_complex(.n) } #' @rdname vector-old-ctors #' @export raw_len <- function(.n) { new_raw(.n) } #' @rdname vector-old-ctors #' @export bytes_len <- function(.n) { new_raw(.n) } #' @rdname vector-old-ctors #' @export list_len <- function(.n) { new_list(.n) } #' @rdname vector-old-ctors #' @export lgl_along <- function(.x) { new_logical_along(.x, NULL) } #' @rdname vector-old-ctors #' @export int_along <- function(.x) { new_integer_along(.x, NULL) } #' @rdname vector-old-ctors #' @export dbl_along <- function(.x) { new_double_along(.x, NULL) } #' @rdname vector-old-ctors #' @export chr_along <- function(.x) { new_character_along(.x, NULL) } #' @rdname vector-old-ctors #' @export cpl_along <- function(.x) { new_complex_along(.x, NULL) } #' @rdname vector-old-ctors #' @export raw_along <- function(.x) { new_raw_along(.x, NULL) } #' @rdname vector-old-ctors #' @export bytes_along <- function(.x) { new_raw_along(.x, NULL) } #' @rdname vector-old-ctors #' @export list_along <- function(.x) { new_list_along(.x, NULL) } #' @rdname vector-old-ctors #' @export node <- function(car, cdr = NULL) { new_node(car, cdr) } rlang/R/s3.R0000644000176200001440000000741013241233650012227 0ustar liggesusers#' Does an object inherit from a set of classes? #' #' @description #' #' * `inherits_any()` is like [base::inherits()] but is more explicit #' about its behaviour with multiple classes. If `classes` contains #' several elements and the object inherits from at least one of #' them, `inherits_any()` returns `TRUE`. #' #' * `inherits_all()` tests that an object inherits from all of the #' classes in the supplied order. This is usually the best way to #' test for inheritance of multiple classes. #' #' * `inherits_only()` tests that the class vectors are identical. It #' is a shortcut for `identical(class(x), class)`. #' #' @param x An object to test for inheritance. #' @param class A character vector of classes. #' #' @export #' @examples #' obj <- structure(list(), class = c("foo", "bar", "baz")) #' #' # With the _any variant only one class must match: #' inherits_any(obj, c("foobar", "bazbaz")) #' inherits_any(obj, c("foo", "bazbaz")) #' #' # With the _all variant all classes must match: #' inherits_all(obj, c("foo", "bazbaz")) #' inherits_all(obj, c("foo", "baz")) #' #' # The order of classes must match as well: #' inherits_all(obj, c("baz", "foo")) #' #' # inherits_only() checks that the class vectors are identical: #' inherits_only(obj, c("foo", "baz")) #' inherits_only(obj, c("foo", "bar", "baz")) inherits_any <- function(x, class) { if (is_empty(class)) { abort("`class` can't be empty") } inherits(x, class) } #' @rdname inherits_any #' @export inherits_all <- function(x, class) { if (is_empty(class)) { abort("`class` can't be empty") } idx <- inherits(x, class, which = TRUE) cummax <- cummax(idx) cummax[[1]] != 0L && all(idx == cummax) } #' @rdname inherits_any #' @export inherits_only <- function(x, class) { identical(class(x), class) } #' Box a value #' #' `new_box()` is similar to [base::I()] but it protects a value by #' wrapping it in a scalar list rather than by adding an attribute. #' `unbox()` retrieves the boxed value. `is_box()` tests whether an #' object is boxed with optional class. `as_box()` ensures that a #' value is wrapped in a box. `as_box_if()` does the same but only if #' the value matches a predicate. #' #' @name box #' @param x,.x An R object. #' @param class,.class For `new_box()`, an additional class for the #' boxed value (in addition to `rlang_box`). For `is_box()`, #' `as_box()` and `as_box_if()`, a class (or vector of classes) to #' be passed to [inherits_all()]. #' @export #' @examples #' boxed <- new_box(letters, "mybox") #' is_box(boxed) #' is_box(boxed, "mybox") #' is_box(boxed, "otherbox") #' #' unbox(boxed) #' #' # as_box() avoids double-boxing: #' boxed2 <- as_box(boxed, "mybox") #' boxed2 #' unbox(boxed2) #' #' # Compare to: #' boxed_boxed <- new_box(boxed, "mybox") #' boxed_boxed #' unbox(unbox(boxed_boxed)) #' #' # Use `as_box_if()` with a predicate if you need to ensure a box #' # only for a subset of values: #' as_box_if(NULL, is_null, "null_box") #' as_box_if("foo", is_null, "null_box") new_box <- function(x, class = NULL) { set_class(list(x), c(class, "rlang_box")) } #' @rdname box #' @export is_box <- function(x, class = NULL) { inherits_all(x, c(class, "rlang_box")) } #' @rdname box #' @export as_box <- function(x, class = NULL) { if (is_box(x, class)) { x } else { new_box(x, class) } } #' @rdname box #' @param .p A predicate function. #' @param ... Arguments passed to `.p`. #' @export as_box_if <- function(.x, .p, .class = NULL, ...) { if (is_box(.x, .class) || !.p(.x, ...)) { .x } else { new_box(.x, .class) } } #' @rdname box #' @param box A boxed value to unbox. #' @export unbox <- function(box) { if (!inherits(box, "rlang_box")) { abort("`box` must be a box") } box[[1]] } print.box <- function(x, ...) { meow("") print(unbox(x)) } rlang/R/vec-coerce.R0000644000176200001440000001641213241233650013717 0ustar liggesusers#' Coerce an object to a base type #' #' These are equivalent to the base functions (e.g. [as.logical()], #' [as.list()], etc), but perform coercion rather than conversion. #' This means they are not generic and will not call S3 conversion #' methods. They only attempt to coerce the base type of their #' input. In addition, they have stricter implicit coercion rules and #' will never attempt any kind of parsing. E.g. they will not try to #' figure out if a character vector represents integers or booleans. #' Finally, they have treat attributes consistently, unlike the base R #' functions: all attributes except names are removed. #' #' #' @section Coercion to logical and numeric atomic vectors: #' #' * To logical vectors: Integer and integerish double vectors. See #' [is_integerish()]. #' * To integer vectors: Logical and integerish double vectors. #' * To double vectors: Logical and integer vectors. #' * To complex vectors: Logical, integer and double vectors. #' #' #' @section Coercion to character vectors: #' #' `as_character()` and `as_string()` have an optional `encoding` #' argument to specify the encoding. R uses this information for #' internal handling of strings and character vectors. Note that this #' is only declarative, no encoding conversion is attempted. See #' [as_utf8_character()] and [as_native_character()] for coercing to a #' character vector and attempt encoding conversion. #' #' See also [set_chr_encoding()] and [mut_utf8_locale()] for #' information about encodings and locales in R, and [string()] and #' [chr()] for other ways of creating strings and character vectors. #' #' Note that only `as_string()` can coerce symbols to a scalar #' character vector. This makes the code more explicit and adds an #' extra type check. #' #' #' @section Coercion to lists: #' #' `as_list()` only coerces vector and dictionary types (environments #' are an example of dictionary type). Unlike [base::as.list()], #' `as_list()` removes all attributes except names. #' #' #' @section Effects of removing attributes: #' #' A technical side-effect of removing the attributes of the input is #' that the underlying objects has to be copied. This has no #' performance implications in the case of lists because this is a #' shallow copy: only the list structure is copied, not the contents #' (see [duplicate()]). However, be aware that atomic vectors #' containing large amounts of data will have to be copied. #' #' In general, any attribute modification creates a copy, which is why #' it is better to avoid using attributes with heavy atomic vectors. #' Uncopyable objects like environments and symbols are an exception #' to this rule: in this case, attributes modification happens in #' place and has side-effects. #' #' @inheritParams string #' @param x An object to coerce to a base type. #' @examples #' # Coercing atomic vectors removes attributes with both base R and rlang: #' x <- structure(TRUE, class = "foo", bar = "baz") #' as.logical(x) #' #' # But coercing lists preserves attributes in base R but not rlang: #' l <- structure(list(TRUE), class = "foo", bar = "baz") #' as.list(l) #' as_list(l) #' #' # Implicit conversions are performed in base R but not rlang: #' as.logical(l) #' \dontrun{ #' as_logical(l) #' } #' #' # Conversion methods are bypassed, making the result of the #' # coercion more predictable: #' as.list.foo <- function(x) "wrong" #' as.list(l) #' as_list(l) #' #' # The input is never parsed. E.g. character vectors of numbers are #' # not converted to numeric types: #' as.integer("33") #' \dontrun{ #' as_integer("33") #' } #' #' #' # With base R tools there is no way to convert an environment to a #' # list without either triggering method dispatch, or changing the #' # original environment. as_list() makes it easy: #' x <- structure(as_environment(mtcars[1:2]), class = "foobar") #' as.list.foobar <- function(x) abort("dont call me") #' as_list(x) #' @name vector-coercion NULL #' @rdname vector-coercion #' @export as_logical <- function(x) { coerce_type_vec(x, friendly_type("logical"), logical = set_attrs(x, NULL), integer = as_base_type(x, as.logical), double = as_integerish_type(x, as.logical, "logical") ) } #' @rdname vector-coercion #' @export as_integer <- function(x) { coerce_type_vec(x, friendly_type("integer"), logical = as_base_type(x, as.integer), integer = set_attrs(x, NULL), double = as_integerish_type(x, as.integer, "integer") ) } #' @rdname vector-coercion #' @export as_double <- function(x) { coerce_type_vec(x, friendly_type("double"), logical = , integer = as_base_type(x, as.double), double = set_attrs(x, NULL) ) } #' @rdname vector-coercion #' @export as_complex <- function(x) { coerce_type_vec(x, friendly_type("complex"), logical = , integer = , double = as_base_type(x, as.complex), complex = set_attrs(x, NULL) ) } #' @rdname vector-coercion #' @export as_character <- function(x, encoding = NULL) { coerce_type_vec(x, friendly_type("character"), string = , character = set_chr_encoding(set_attrs(x, NULL), encoding) ) } #' @rdname vector-coercion #' @export as_string <- function(x, encoding = NULL) { x <- coerce_type(x, friendly_type("string"), symbol = { if (!is.null(encoding)) { warn("`encoding` argument ignored for symbols") } .Call(rlang_symbol_to_character, x) }, string = set_attrs(x, NULL) ) set_chr_encoding(x, encoding) } #' @rdname vector-coercion #' @export as_list <- function(x) { switch_type(x, environment = env_as_list(x), vec_as_list(x) ) } env_as_list <- function(x) { names_x <- names(x) x <- as_base_type(x, as.list) set_names(x, .Call(rlang_unescape_character, names_x)) } vec_as_list <- function(x) { coerce_type_vec(x, friendly_type("list"), logical = , integer = , double = , string = , character = , complex = , raw = as_base_type(x, as.list), list = set_attrs(x, NULL) ) } as_base_type <- function(x, as_type) { # Zap attributes temporarily instead of unclassing. We want to avoid # method dispatch, but we also want to avoid an extra copy of atomic # vectors: the first when unclassing, the second when coercing. This # is also useful for uncopyable types like environments. attrs <- .Call(rlang_get_attrs, x) .Call(rlang_zap_attrs, x) # This function assumes that the target type is different than the # input type, otherwise no duplication is done and the output will # be modified by side effect when we restore the input attributes. on.exit(.Call(rlang_set_attrs, x, attrs)) as_type(x) } as_integerish_type <- function(x, as_type, to) { if (is_integerish(x)) { as_base_type(x, as_type) } else { abort(paste0( "Can't convert a fractional double vector to ", friendly_type(to), "" )) } } coerce_type_vec <- function(.x, .to, ...) { # Cannot reuse coerce_type() because switch() has a bug with # fallthrough and multiple levels of dots forwarding. out <- switch(type_of(.x), ..., abort_coercion(.x, .to)) if (!is_null(names(.x))) { # Avoid a copy of `out` when we restore the names, since it could be # a heavy atomic vector. We own `out`, so it is ok to change its # attributes inplace. .Call(rlang_set_attrs, out, pairlist(names = names(.x))) } out } vec_coerce <- function(x, type) { .Call(rlang_vec_coerce, x, type) } rlang/R/vec-new.R0000644000176200001440000001443313242734417013261 0ustar liggesusers#' Create vectors #' #' @description #' #' The atomic vector constructors are equivalent to [c()] but: #' #' * They allow you to be more explicit about the output #' type. Implicit coercions (e.g. from integer to logical) follow #' the rules described in [vector-coercion]. #' #' * They use [tidy dots][tidy-dots] and thus support splicing with `!!!`. #' #' #' @section Life cycle: #' #' * Automatic splicing is soft-deprecated and will trigger a warning #' in a future version. Please splice explicitly with `!!!`. #' #' @param ... Components of the new vector. Bare lists and explicitly #' spliced lists are spliced. #' @name vector-construction #' @examples #' # These constructors are like a typed version of c(): #' c(TRUE, FALSE) #' lgl(TRUE, FALSE) #' #' # They follow a restricted set of coercion rules: #' int(TRUE, FALSE, 20) #' #' # Lists can be spliced: #' dbl(10, !!! list(1, 2L), TRUE) #' #' #' # They splice names a bit differently than c(). The latter #' # automatically composes inner and outer names: #' c(a = c(A = 10), b = c(B = 20, C = 30)) #' #' # On the other hand, rlang's ctors use the inner names and issue a #' # warning to inform the user that the outer names are ignored: #' dbl(a = c(A = 10), b = c(B = 20, C = 30)) #' dbl(a = c(1, 2)) #' #' # As an exception, it is allowed to provide an outer name when the #' # inner vector is an unnamed scalar atomic: #' dbl(a = 1) #' #' # Spliced lists behave the same way: #' dbl(!!! list(a = 1)) #' dbl(!!! list(a = c(A = 1))) NULL #' @rdname vector-construction #' @export lgl <- function(...) { .Call(rlang_squash, dots_values(...), "logical", is_spliced_bare, 1L) } #' @rdname vector-construction #' @export int <- function(...) { .Call(rlang_squash, dots_values(...), "integer", is_spliced_bare, 1L) } #' @rdname vector-construction #' @export dbl <- function(...) { .Call(rlang_squash, dots_values(...), "double", is_spliced_bare, 1L) } #' @rdname vector-construction #' @export cpl <- function(...) { .Call(rlang_squash, dots_values(...), "complex", is_spliced_bare, 1L) } #' @rdname vector-construction #' @export #' @param .encoding If non-null, passed to [set_chr_encoding()] to add #' an encoding mark. This is only declarative, no encoding #' conversion is performed. #' @export chr <- function(..., .encoding = NULL) { out <- .Call(rlang_squash, dots_values(...), "character", is_spliced_bare, 1L) set_chr_encoding(out, .encoding) } #' @rdname vector-construction #' @export #' @examples #' #' # bytes() accepts integerish inputs #' bytes(1:10) #' bytes(0x01, 0xff, c(0x03, 0x05), list(10, 20, 30L)) bytes <- function(...) { dots <- map(dots_values(...), function(dot) { if (is_bare_list(dot) || is_spliced(dot)) { map(dot, new_bytes) } else { new_bytes(dot) } }) .Call(rlang_squash, dots, "raw", is_spliced_bare, 1L) } #' @rdname tidy-dots #' @export list2 <- function(...) { .Call(rlang_dots_list, environment(), FALSE, "trailing", TRUE) } #' @rdname vector-construction #' @export ll <- function(...) { .Call(rlang_dots_list, environment(), FALSE, "trailing", TRUE) } #' Create vectors matching a given length #' #' These functions construct vectors of given length, with attributes #' specified via dots. Except for `new_list()` and `new_bytes()`, the #' empty vectors are filled with typed [missing] values. This is in #' contrast to the base function [base::vector()] which creates #' zero-filled vectors. #' #' @param n The vector length. #' @param names Names for the new vector. #' @examples #' new_list(10) #' new_logical(10) #' @name new-vector #' @seealso new-vector-along NULL #' @rdname new-vector #' @export new_logical <- function(n, names = NULL) { set_names(rep_len(na_lgl, n), names) } #' @rdname new-vector #' @export new_integer <- function(n, names = NULL) { set_names(rep_len(na_int, n), names) } #' @rdname new-vector #' @export new_double <- function(n, names = NULL) { set_names(rep_len(na_dbl, n), names) } #' @rdname new-vector #' @export new_character <- function(n, names = NULL) { set_names(rep_len(na_chr, n), names) } #' @rdname new-vector #' @export new_complex <- function(n, names = NULL) { set_names(rep_len(na_cpl, n), names) } #' @rdname new-vector #' @export new_raw <- function(n, names = NULL) { set_names(vector("raw", n), names) } #' @rdname new-vector #' @export new_list <- function(n, names = NULL) { set_names(vector("list", n), names) } #' Create vectors matching the length of a given vector #' #' These functions take the idea of [seq_along()] and generalise it to #' creating lists (`new_list_along`) and repeating values (`rep_along`). #' Except for `new_list_along()` and `new_raw_along()`, the empty #' vectors are filled with typed `missing` values. #' #' @param x,.x A vector. #' @param .y Values to repeat. #' @param names Names for the new vector. Defaults to the names of #' `x`. This can be a function to apply to the names of `x` as in #' [set_names()]. #' @examples #' x <- 0:5 #' rep_along(x, 1:2) #' rep_along(x, 1) #' new_list_along(x) #' #' # The default names are picked up from the input vector #' x <- c(a = "foo", b = "bar") #' new_character_along(x) #' @name new-vector-along #' @seealso new-vector NULL #' @export #' @rdname new-vector-along new_logical_along <- function(x, names = base::names(x)) { set_names_impl(rep_len(na_lgl, length(x)), x, names) } #' @export #' @rdname new-vector-along new_integer_along <- function(x, names = base::names(x)) { set_names_impl(rep_len(na_int, length(x)), x, names) } #' @export #' @rdname new-vector-along new_double_along <- function(x, names = base::names(x)) { set_names_impl(rep_len(na_dbl, length(x)), x, names) } #' @export #' @rdname new-vector-along new_character_along <- function(x, names = base::names(x)) { set_names_impl(rep_len(na_chr, length(x)), x, names) } #' @export #' @rdname new-vector-along new_complex_along <- function(x, names = base::names(x)) { set_names_impl(rep_len(na_cpl, length(x)), x, names) } #' @export #' @rdname new-vector-along new_raw_along <- function(x, names = base::names(x)) { set_names_impl(vector("raw", length(x)), x, names) } #' @export #' @rdname new-vector-along new_list_along <- function(x, names = base::names(x)) { set_names_impl(vector("list", length(x)), x, names) } #' @export #' @rdname new-vector-along rep_along <- function(.x, .y) { rep(.y, length.out = length(.x)) } rlang/R/attr.R0000644000176200001440000002051113241304306012646 0ustar liggesusers#' Add attributes to an object #' #' `set_attrs()` adds, changes, or zaps attributes of objects. Pass a #' single unnamed `NULL` as argument to zap all attributes. For #' [uncopyable][is_copyable] types, use `mut_attrs()`. #' #' Unlike [structure()], these setters have no special handling of #' internal attributes names like `.Dim`, `.Dimnames` or `.Names`. #' #' #' @section Life cycle: #' #' These functions are experimental, expect API changes. #' #' * `set_attrs()` should probably set the attributes as a #' whole. Another function with `add_` prefix would be in charge of #' adding an attribute to the set. #' #' * `mut_attrs()` should be renamed to use the `poke_` prefix. Also #' it may be useful to allow any kind of objects, not just #' [non-copyable][is_copyable] ones. #' #' @param .x An object to decorate with attributes. #' @param ... A list of named attributes. These have [explicit #' splicing semantics][tidy-dots]. Pass a single unnamed `NULL` to #' zap all attributes from `.x`. #' @return `set_attrs()` returns a modified [shallow copy][duplicate] #' of `.x`. `mut_attrs()` invisibly returns the original `.x` #' modified in place. #' #' @keywords internal #' @export #' @examples #' set_attrs(letters, names = 1:26, class = "my_chr") #' #' # Splice a list of attributes: #' attrs <- list(attr = "attr", names = 1:26, class = "my_chr") #' obj <- set_attrs(letters, splice(attrs)) #' obj #' #' # Zap attributes by passing a single unnamed NULL argument: #' set_attrs(obj, NULL) #' set_attrs(obj, !!! list(NULL)) #' #' # Note that set_attrs() never modifies objects in place: #' obj #' #' # For uncopyable types, mut_attrs() lets you modify in place: #' env <- env() #' mut_attrs(env, foo = "bar") #' env set_attrs <- function(.x, ...) { if (!is_copyable(.x)) { abort("`.x` is uncopyable: use `mut_attrs()` to change attributes in place") } set_attrs_impl(.x, ...) } #' @rdname set_attrs #' @export mut_attrs <- function(.x, ...) { if (is_copyable(.x)) { abort("`.x` is copyable: use `set_attrs()` to change attributes without side effect") } invisible(set_attrs_impl(.x, ...)) } set_attrs_impl <- function(.x, ...) { attrs <- dots_list(...) # If passed a single unnamed NULL, zap attributes if (identical(attrs, set_attrs_null)) { attributes(.x) <- NULL } else { attributes(.x) <- c(attributes(.x), attrs) } .x } set_attrs_null <- list(NULL) names(set_attrs_null) <- "" add_attributes <- set_attrs set_class <- function(x, class) { add_attributes(x, class = class) } #' Is object named? #' #' `is_named()` checks that `x` has names attributes, and that none of #' the names are missing or empty (`NA` or `""`). `is_dictionaryish()` #' checks that an object is a dictionary: that it has actual names and #' in addition that there are no duplicated names. `have_name()` #' is a vectorised version of `is_named()`. #' #' @param x An object to test. #' @return `is_named()` and `is_dictionaryish()` are scalar predicates #' and return `TRUE` or `FALSE`. `have_name()` is vectorised and #' returns a logical vector as long as the input. #' @export #' @examples #' # A data frame usually has valid, unique names #' is_named(mtcars) #' have_name(mtcars) #' is_dictionaryish(mtcars) #' #' # But data frames can also have duplicated columns: #' dups <- cbind(mtcars, cyl = seq_len(nrow(mtcars))) #' is_dictionaryish(dups) #' #' # The names are still valid: #' is_named(dups) #' have_name(dups) #' #' #' # For empty objects the semantics are slightly different. #' # is_dictionaryish() returns TRUE for empty objects: #' is_dictionaryish(list()) #' #' # But is_named() will only return TRUE if there is a names #' # attribute (a zero-length character vector in this case): #' x <- set_names(list(), character(0)) #' is_named(x) #' #' #' # Empty and missing names are invalid: #' invalid <- dups #' names(invalid)[2] <- "" #' names(invalid)[5] <- NA #' #' # is_named() performs a global check while have_name() can show you #' # where the problem is: #' is_named(invalid) #' have_name(invalid) #' #' # have_name() will work even with vectors that don't have a names #' # attribute: #' have_name(letters) is_named <- function(x) { nms <- names(x) if (is_null(nms)) { return(FALSE) } if (any(nms == "" | is.na(nms))) { return(FALSE) } TRUE } #' @rdname is_named #' @export is_dictionaryish <- function(x) { if (!length(x)) { return(!is.null(x)) } is_named(x) && !any(duplicated(names(x))) } #' @rdname is_named #' @export have_name <- function(x) { nms <- names(x) if (is.null(nms)) { rep(FALSE, length(x)) } else { !(is.na(nms) | nms == "") } } #' Does an object have an element with this name? #' #' This function returns a logical value that indicates if a data frame or #' another named object contains an element with a specific name. #' #' Unnamed objects are treated as if all names are empty strings. `NA` #' input gives `FALSE` as output. #' #' @param x A data frame or another named object #' @param name Element name(s) to check #' @return A logical vector of the same length as `name` #' @examples #' has_name(iris, "Species") #' has_name(mtcars, "gears") #' @export has_name <- function(x, name) { name %in% names2(x) } #' Set names of a vector #' #' This is equivalent to [stats::setNames()], with more features and #' stricter argument checking. #' #' #' @section Life cycle: #' #' `set_names()` is stable and exported in purrr. #' #' @param x Vector to name. #' @param nm,... Vector of names, the same length as `x`. #' #' You can specify names in the following ways: #' #' * If you do nothing, `x` will be named with itself. #' #' * If `x` already has names, you can provide a function or formula #' to transform the existing names. In that case, `...` is passed #' to the function. #' #' * If `nm` is `NULL`, the names are removed (if present). #' #' * In all other cases, `nm` and `...` are coerced to character. #' #' @export #' @examples #' set_names(1:4, c("a", "b", "c", "d")) #' set_names(1:4, letters[1:4]) #' set_names(1:4, "a", "b", "c", "d") #' #' # If the second argument is ommitted a vector is named with itself #' set_names(letters[1:5]) #' #' # Alternatively you can supply a function #' set_names(1:10, ~ letters[seq_along(.)]) #' set_names(head(mtcars), toupper) #' #' # `...` is passed to the function: #' set_names(head(mtcars), paste0, "_foo") set_names <- function(x, nm = x, ...) { set_names_impl(x, x, nm, ...) } set_names_impl <- function(x, mold, nm, ...) { if (!is_vector(x)) { abort("`x` must be a vector") } if (is_function(nm) || is_formula(nm)) { nm <- as_function(nm) nm <- nm(names2(mold), ...) } else if (!is_null(nm)) { if (dots_n(...)) { nm <- as.character(c(nm, ...)) } else { nm <- as.character(nm) } } if (!is_null(nm) && !is_character(nm, length(x))) { abort("`nm` must be `NULL` or a character vector the same length as `x`") } names(x) <- nm x } #' Get names of a vector #' #' This names getter always returns a character vector, even when an #' object does not have a `names` attribute. In this case, it returns #' a vector of empty names `""`. It also standardises missing names to #' `""`. #' #' #' @section Life cycle: #' #' `names2()` is stable. #' #' @param x A vector. #' @export #' @examples #' names2(letters) #' #' # It also takes care of standardising missing names: #' x <- set_names(1:3, c("a", NA, "b")) #' names2(x) names2 <- function(x) { if (type_of(x) == "environment") abort("Use env_names() for environments.") nms <- names(x) if (is_null(nms)) { rep("", length(x)) } else { nms %|% "" } } length_ <- function(x) { .Call(rlang_length, x) } #' How long is an object? #' #' This is a function for the common task of testing the length of an #' object. It checks the length of an object in a non-generic way: #' [base::length()] methods are ignored. #' #' @param x A R object. #' @param n A specific length to test `x` with. If `NULL`, #' `has_length()` returns `TRUE` if `x` has length greater than #' zero, and `FALSE` otherwise. #' @export #' @examples #' has_length(list()) #' has_length(list(), 0) #' #' has_length(letters) #' has_length(letters, 20) #' has_length(letters, 26) has_length <- function(x, n = NULL) { len <- .Call(rlang_length, x) if (is_null(n)) { as.logical(len) } else { len == n } } poke_attributes <- function(x, attrs) { .Call(rlang_poke_attributes, x, attrs) } rlang/R/types.R0000644000176200001440000005256413241233650013060 0ustar liggesusers#' Type predicates #' #' These type predicates aim to make type testing in R more #' consistent. They are wrappers around [base::typeof()], so operate #' at a level beneath S3/S4 etc. #' #' Compared to base R functions: #' #' * The predicates for vectors include the `n` argument for #' pattern-matching on the vector length. #' #' * Unlike `is.atomic()`, `is_atomic()` does not return `TRUE` for #' `NULL`. #' #' * Unlike `is.vector()`, `is_vector()` test if an object is an #' atomic vector or a list. `is.vector` checks for the presence of #' attributes (other than name). #' #' @param x Object to be tested. #' @param n Expected length of a vector. #' @param finite Whether values must be finite. Examples of non-finite #' values are `Inf`, `-Inf` and `NaN`. #' @param encoding Expected encoding of a string or character #' vector. One of `UTF-8`, `latin1`, or `unknown`. #' @seealso [bare-type-predicates] [scalar-type-predicates] #' @name type-predicates NULL #' @export #' @rdname type-predicates is_list <- function(x, n = NULL) { if (typeof(x) != "list") return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) TRUE } parsable_atomic_types <- c("logical", "integer", "double", "complex", "character") atomic_types <- c(parsable_atomic_types, "raw") #' @export #' @rdname type-predicates is_atomic <- function(x, n = NULL) { if (!typeof(x) %in% atomic_types) return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) TRUE } #' @export #' @rdname type-predicates is_vector <- function(x, n = NULL) { is_atomic(x, n) || is_list(x, n) } #' @export #' @rdname type-predicates is_integer <- function(x, n = NULL) { if (typeof(x) != "integer") return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) TRUE } #' @export #' @rdname type-predicates is_double <- function(x, n = NULL, finite = NULL) { if (typeof(x) != "double") return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) if (!is_null(finite)) { if (finite) { return(all(is.finite(x))) } else { return(!any(is.finite(x))) } } TRUE } #' @export #' @rdname type-predicates is_character <- function(x, n = NULL, encoding = NULL) { if (typeof(x) != "character") return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) stopifnot(typeof(encoding) %in% c("character", "NULL")) if (!is_null(encoding) && !all(chr_encoding(x) %in% encoding)) return(FALSE) TRUE } #' @export #' @rdname type-predicates is_logical <- function(x, n = NULL) { if (typeof(x) != "logical") return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) TRUE } #' @export #' @rdname type-predicates is_raw <- function(x, n = NULL) { if (typeof(x) != "raw") return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) TRUE } #' @export #' @rdname type-predicates is_bytes <- is_raw #' @export #' @rdname type-predicates is_null <- function(x) { .Call(rlang_is_null, x) } #' Scalar type predicates #' #' These predicates check for a given type and whether the vector is #' "scalar", that is, of length 1. #' @inheritParams type-predicates #' @param x object to be tested. #' @seealso [type-predicates], [bare-type-predicates] #' @name scalar-type-predicates NULL #' @export #' @rdname scalar-type-predicates is_scalar_list <- function(x) { is_list(x, n = 1) } #' @export #' @rdname scalar-type-predicates is_scalar_atomic <- function(x) { is_atomic(x, n = 1) } #' @export #' @rdname scalar-type-predicates is_scalar_vector <- function(x) { is_vector(x, n = 1) } #' @export #' @rdname scalar-type-predicates is_scalar_integer <- function(x) { is_integer(x, n = 1) } #' @export #' @rdname scalar-type-predicates is_scalar_double <- function(x) { is_double(x, n = 1) } #' @export #' @rdname scalar-type-predicates is_scalar_character <- function(x, encoding = NULL) { is_character(x, encoding = encoding, n = 1) } #' @export #' @rdname scalar-type-predicates is_scalar_logical <- function(x) { is_logical(x, n = 1) } #' @export #' @rdname scalar-type-predicates is_scalar_raw <- function(x) { is_raw(x, n = 1) } #' @export #' @rdname scalar-type-predicates is_string <- is_scalar_character #' @export #' @rdname scalar-type-predicates is_scalar_bytes <- is_scalar_raw #' Bare type predicates #' #' These predicates check for a given type but only return `TRUE` for #' bare R objects. Bare objects have no class attributes. For example, #' a data frame is a list, but not a bare list. #' #' * The predicates for vectors include the `n` argument for #' pattern-matching on the vector length. #' #' * Like [is_atomic()] and unlike base R `is.atomic()`, #' `is_bare_atomic()` does not return `TRUE` for `NULL`. #' #' * Unlike base R `is.numeric()`, `is_bare_double()` only returns #' `TRUE` for floating point numbers. #' @inheritParams type-predicates #' @seealso [type-predicates], [scalar-type-predicates] #' @name bare-type-predicates NULL #' @export #' @rdname bare-type-predicates is_bare_list <- function(x, n = NULL) { !is.object(x) && is_list(x, n) } #' @export #' @rdname bare-type-predicates is_bare_atomic <- function(x, n = NULL) { !is.object(x) && is_atomic(x, n) } #' @export #' @rdname bare-type-predicates is_bare_vector <- function(x, n = NULL) { is_bare_atomic(x) || is_bare_list(x, n) } #' @export #' @rdname bare-type-predicates is_bare_double <- function(x, n = NULL) { !is.object(x) && is_double(x, n) } #' @export #' @rdname bare-type-predicates is_bare_integer <- function(x, n = NULL) { !is.object(x) && is_integer(x, n) } #' @export #' @rdname bare-type-predicates is_bare_numeric <- function(x, n = NULL) { if (!is_null(n) && length(x) != n) return(FALSE) !is.object(x) && typeof(x) %in% c("double", "integer") } #' @export #' @rdname bare-type-predicates is_bare_character <- function(x, n = NULL, encoding = NULL) { !is.object(x) && is_character(x, n, encoding = encoding) } #' @export #' @rdname bare-type-predicates is_bare_logical <- function(x, n = NULL) { !is.object(x) && is_logical(x, n) } #' @export #' @rdname bare-type-predicates is_bare_raw <- function(x, n = NULL) { !is.object(x) && is_raw(x, n) } #' @export #' @rdname bare-type-predicates is_bare_string <- function(x, n = NULL) { !is.object(x) && is_string(x, n) } #' @export #' @rdname bare-type-predicates is_bare_bytes <- is_bare_raw #' Is object an empty vector or NULL? #' #' @param x object to test #' @export #' @examples #' is_empty(NULL) #' is_empty(list()) #' is_empty(list(NULL)) is_empty <- function(x) length(x) == 0 #' Is object an environment? #' #' `is_bare_env()` tests whether `x` is an environment without a s3 or #' s4 class. #' #' @inheritParams is_empty #' @export is_env <- function(x) { typeof(x) == "environment" } #' @rdname is_env #' @export is_bare_env <- function(x) { !is.object(x) && typeof(x) == "environment" } # Anticipate renaming is_environment <- is_env is_bare_environment <- is_bare_env #' Is object identical to TRUE or FALSE? #' #' These functions bypass R's automatic conversion rules and check #' that `x` is literally `TRUE` or `FALSE`. #' @inheritParams is_empty #' @export #' @examples #' is_true(TRUE) #' is_true(1) #' #' is_false(FALSE) #' is_false(0) is_true <- function(x) { identical(x, TRUE) } #' @rdname is_true #' @export is_false <- function(x) { identical(x, FALSE) } #' Is a vector integer-like? #' #' These predicates check whether R considers a number vector to be #' integer-like, according to its own tolerance check (which is in #' fact delegated to the C library). This function is not adapted to #' data analysis, see the help for [base::is.integer()] for examples #' of how to check for whole numbers. #' #' @seealso [is_bare_numeric()] for testing whether an object is a #' base numeric type (a bare double or integer vector). #' @inheritParams type-predicates #' @export #' @examples #' is_integerish(10L) #' is_integerish(10.0) #' is_integerish(10.0, n = 2) #' is_integerish(10.000001) #' is_integerish(TRUE) is_integerish <- function(x, n = NULL, finite = TRUE) { if (!typeof(x) %in% c("double", "integer")) return(FALSE) if (!is_null(n) && length(x) != n) return(FALSE) missing_elts <- is.na(x) finite_elts <- is.finite(x) | missing_elts if (is_true(finite) && !all(finite_elts)) { return(FALSE) } else if (is_false(finite)) { return(!any(finite_elts)) } x_finite <- x[finite_elts & !missing_elts] all(x_finite == as.integer(x_finite)) } #' @rdname is_integerish #' @export is_bare_integerish <- function(x, n = NULL) { !is.object(x) && is_integerish(x, n) } #' @rdname is_integerish #' @export is_scalar_integerish <- function(x) { !is.object(x) && is_integerish(x, 1L) } #' Base type of an object #' #' This is equivalent to [base::typeof()] with a few differences that #' make dispatching easier: #' * The type of one-sided formulas is "quote". #' * The type of character vectors of length 1 is "string". #' * The type of special and builtin functions is "primitive". #' #' #' @section Life cycle: #' #' `type_of()` is an experimental function. Expect API changes. #' #' @param x An R object. #' @export #' @keywords internal #' @examples #' type_of(10L) #' #' # Quosures are treated as a new base type but not formulas: #' type_of(quo(10L)) #' type_of(~10L) #' #' # Compare to base::typeof(): #' typeof(quo(10L)) #' #' # Strings are treated as a new base type: #' type_of(letters) #' type_of(letters[[1]]) #' #' # This is a bit inconsistent with the core language tenet that data #' # types are vectors. However, treating strings as a different #' # scalar type is quite helpful for switching on function inputs #' # since so many arguments expect strings: #' switch_type("foo", character = abort("vector!"), string = "result") #' #' # Special and builtin primitives are both treated as primitives. #' # That's because it is often irrelevant which type of primitive an #' # input is: #' typeof(list) #' typeof(`$`) #' type_of(list) #' type_of(`$`) type_of <- function(x) { type <- typeof(x) if (is_formulaish(x)) { if (identical(node_car(x), colon_equals_sym)) { "definition" } else { "formula" } } else if (type == "character") { if (length(x) == 1) "string" else "character" } else if (type %in% c("builtin", "special")) { "primitive" } else { type } } #' Dispatch on base types #' #' `switch_type()` is equivalent to #' \code{\link[base]{switch}(\link{type_of}(x, ...))}, while #' `switch_class()` switchpatches based on `class(x)`. The `coerce_` #' versions are intended for type conversion and provide a standard #' error message when conversion fails. #' #' #' @section Life cycle: #' #' * Like [type_of()], `switch_type()` and `coerce_type()` are #' experimental functions. #' #' * `switch_class()` and `coerce_class()` are experimental functions. #' #' @param .x An object from which to dispatch. #' @param ... Named clauses. The names should be types as returned by #' [type_of()]. #' @param .to This is useful when you switchpatch within a coercing #' function. If supplied, this should be a string indicating the #' target type. A catch-all clause is then added to signal an error #' stating the conversion failure. This type is prettified unless #' `.to` inherits from the S3 class `"AsIs"` (see [base::I()]). #' @seealso [switch_lang()] #' @export #' @keywords internal #' @examples #' switch_type(3L, #' double = "foo", #' integer = "bar", #' "default" #' ) #' #' # Use the coerce_ version to get standardised error handling when no #' # type matches: #' to_chr <- function(x) { #' coerce_type(x, "a chr", #' integer = as.character(x), #' double = as.character(x) #' ) #' } #' to_chr(3L) #' #' # Strings have their own type: #' switch_type("str", #' character = "foo", #' string = "bar", #' "default" #' ) #' #' # Use a fallthrough clause if you need to dispatch on all character #' # vectors, including strings: #' switch_type("str", #' string = , #' character = "foo", #' "default" #' ) #' #' # special and builtin functions are treated as primitive, since #' # there is usually no reason to treat them differently: #' switch_type(base::list, #' primitive = "foo", #' "default" #' ) #' switch_type(base::`$`, #' primitive = "foo", #' "default" #' ) #' #' # closures are not primitives: #' switch_type(rlang::switch_type, #' primitive = "foo", #' "default" #' ) switch_type <- function(.x, ...) { switch(type_of(.x), ...) } #' @rdname switch_type #' @export coerce_type <- function(.x, .to, ...) { switch(type_of(.x), ..., abort_coercion(.x, .to)) } #' @rdname switch_type #' @export switch_class <- function(.x, ...) { switch(class(.x), ...) } #' @rdname switch_type #' @export coerce_class <- function(.x, .to, ...) { switch(class(.x), ..., abort_coercion(.x, .to)) } abort_coercion <- function(x, to_type) { x_type <- friendly_type(type_of(x)) if (!inherits(to_type, "AsIs")) { to_type <- friendly_type(to_type) } abort(paste0("Can't convert ", x_type, " to ", to_type)) } #' Format a type for error messages #' #' @section Life cycle: #' #' * Like [type_of()], `friendly_type()` is experimental. #' #' @param type A type as returned by [type_of()] or [lang_type_of()]. #' @return A string of the prettified type, qualified with an #' indefinite article. #' @export #' @keywords internal #' @examples #' friendly_type("logical") #' friendly_type("integer") #' friendly_type("string") #' @export friendly_type <- function(type) { friendly <- friendly_type_of(type) if (!is_null(friendly)) { return(friendly) } friendly <- friendly_lang_type_of(type) if (!is_null(friendly)) { return(friendly) } friendly <- friendly_expr_type_of(type) if (!is_null(friendly)) { return(friendly) } type } friendly_type_of <- function(type) { switch(type, logical = "a logical vector", integer = "an integer vector", numeric = , double = "a double vector", complex = "a complex vector", character = "a character vector", raw = "a raw vector", string = "a string", list = "a list", NULL = "NULL", environment = "an environment", externalptr = "a pointer", weakref = "a weak reference", S4 = "an S4 object", name = , symbol = "a symbol", language = "a call", pairlist = "a pairlist node", expression = "an expression vector", quosure = "a quosure", char = "an internal string", promise = "an internal promise", ... = "an internal dots object", any = "an internal `any` object", bytecode = "an internal bytecode object", primitive = , builtin = , special = "a primitive function", closure = "a function" ) } friendly_lang_type_of <- function(type) { switch(type, named = "a named call", namespaced = "a namespaced call", recursive = "a recursive call", inlined = "an inlined call" ) } friendly_expr_type_of <- function(type) { switch(type, NULL = "NULL", name = , symbol = "a symbol", language = "a call", pairlist = "a pairlist node", literal = "a syntactic literal", missing = "the missing argument" ) } #' Dispatch on call type #' #' `switch_lang()` dispatches clauses based on the subtype of call, as #' determined by `lang_type_of()`. The subtypes are based on the type #' of call head (see details). #' #' Calls (objects of type `language`) do not necessarily call a named #' function. They can also call an anonymous function or the result of #' some other expression. The language subtypes are organised around #' the kind of object being called: #' #' * For regular calls to named function, `switch_lang()` returns #' "named". #' #' * Sometimes the function being called is the result of another #' function call, e.g. `foo()()`, or the result of another #' subsetting call, e.g. `foo$bar()` or `foo@bar()`. In this case, #' the call head is not a symbol, it is another call (e.g. to the #' infix functions `$` or `@`). The call subtype is said to be #' "recursive". #' #' * A special subset of recursive calls are namespaced calls like #' `foo::bar()`. `switch_lang()` returns "namespaced" for these #' calls. It is generally a good idea if your function treats #' `bar()` and `foo::bar()` similarly. #' #' * Finally, it is possible to have a literal (see [is_expression()] for a #' definition of literals) as call head. In most cases, this will be #' a function inlined in the call (this is sometimes an expedient #' way of dealing with scoping issues). For calls with a literal #' node head, `switch_lang()` returns "inlined". Note that if a call #' head contains a literal that is not function, something went #' wrong and using that object will probably make R crash. #' `switch_lang()` issues an error in this case. #' #' The reason we use the term _node head_ is because calls are #' structured as tree objects. This makes sense because the best #' representation for language code is a tree whose hierarchy is #' determined by the order of operations. See [node] for more on this. #' #' #' @section Life cycle: #' #' * `lang_type_of()` is an experimental function. #' * `switch_lang()` and `coerce_lang()` are experimental functions. #' #' @inheritParams switch_type #' @param .x,x A language object (a call). If a formula quote, the RHS #' is extracted first. #' @param ... Named clauses. The names should be types as returned by #' `lang_type_of()`. #' #' @keywords internal #' @export #' @examples #' # Named calls: #' lang_type_of(~foo()) #' #' # Recursive calls: #' lang_type_of(~foo$bar()) #' lang_type_of(~foo()()) #' #' # Namespaced calls: #' lang_type_of(~base::list()) #' #' # For an inlined call, let's inline a function in the head node: #' call <- quote(foo(letters)) #' call[[1]] <- base::toupper #' #' call #' lang_type_of(call) switch_lang <- function(.x, ...) { switch(lang_type_of(.x), ...) } #' @rdname switch_lang #' @export coerce_lang <- function(.x, .to, ...) { msg <- paste0("Can't convert ", type_of(.x), " to ", .to, "") switch(lang_type_of(.x), ..., abort(msg)) } #' @rdname switch_lang #' @export lang_type_of <- function(x) { x <- get_expr(x) stopifnot(typeof(x) == "language") type <- typeof(node_car(x)) if (type == "symbol") { "named" } else if (is_namespaced_symbol(node_car(x))) { "namespaced" } else if (type == "language") { "recursive" } else if (type %in% c("closure", "builtin", "special")) { "inlined" } else { abort("corrupt language object") } } #' Is an object copyable? #' #' When an object is modified, R generally copies it (sometimes #' lazily) to enforce [value #' semantics](https://en.wikipedia.org/wiki/Value_semantics). #' However, some internal types are uncopyable. If you try to copy #' them, either with `<-` or by argument passing, you actually create #' references to the original object rather than actual #' copies. Modifying these references can thus have far reaching side #' effects. #' #' @param x An object to test. #' @export #' @examples #' # Let's add attributes with structure() to uncopyable types. Since #' # they are not copied, the attributes are changed in place: #' env <- env() #' structure(env, foo = "bar") #' env #' #' # These objects that can only be changed with side effect are not #' # copyable: #' is_copyable(env) #' #' structure(base::list, foo = "bar") #' str(base::list) is_copyable <- function(x) { switch_type(x, NULL = , char = , symbol = , primitive = , environment = , pointer = FALSE, TRUE ) } is_equal <- function(x, y) { identical(x, y) } #' Is an object referencing another? #' #' @description #' #' There are typically two situations where two symbols may refer to #' the same object. #' #' * R objects usually have copy-on-write semantics. This is an #' optimisation that ensures that objects are only copied if #' needed. When you copy a vector, no memory is actually copied #' until you modify either the original object or the copy is #' modified. #' #' Note that the copy-on-write optimisation is an implementation #' detail that is not guaranteed by the specification of the R #' language. #' #' * Assigning an [uncopyable][is_copyable] object (like an #' environment) creates a reference. These objects are never copied #' even if you modify one of the references. #' #' @param x,y R objects. #' @export #' @examples #' # Reassigning an uncopyable object such as an environment creates a #' # reference: #' env <- env() #' ref <- env #' is_reference(ref, env) #' #' # Due to copy-on-write optimisation, a copied vector can #' # temporarily reference the original vector: #' vec <- 1:10 #' copy <- vec #' is_reference(copy, vec) #' #' # Once you modify on of them, the copy is triggered in the #' # background and the objects cease to reference each other: #' vec[[1]] <- 100 #' is_reference(copy, vec) is_reference <- function(x, y) { .Call(rlang_is_reference, x, y) } # Use different generic name to avoid import warnings when loading # packages that import all of rlang after it has been load_all'd rlang_type_sum <- function(x) { if (is_installed("pillar")) { pillar::type_sum(x) } else { UseMethod("type_sum") } } type_sum.ordered <- function(x) "ord" type_sum.factor <- function(x) "fct" type_sum.POSIXct <- function(x) "dttm" type_sum.difftime <- function(x) "time" type_sum.Date <- function(x) "date" type_sum.data.frame <- function(x) class(x)[[1]] type_sum.default <- function(x) { if (!is.object(x)) { switch(typeof(x), logical = "lgl", integer = "int", double = "dbl", character = "chr", complex = "cpl", closure = "fn", environment = "env", typeof(x) ) } else if (!isS4(x)) { paste0("S3: ", class(x)[[1]]) } else { paste0("S4: ", methods::is(x)[[1]]) } } rlang/R/call.R0000644000176200001440000003452613241305652012627 0ustar liggesusers#' Create a call #' #' @description #' #' Language objects are (with symbols) one of the two types of #' [symbolic][is_symbolic] objects in R. These symbolic objects form #' the backbone of [expressions][is_expression]. They represent a value, #' unlike literal objects which are their own values. While symbols #' are directly [bound][env_bind] to a value, language objects #' represent _function calls_, which is why they are commonly referred #' to as calls. #' #' `call2()` creates a call from a function name (or a literal #' function to inline in the call) and a list of arguments. #' #' #' @section Life cycle: #' #' In rlang 0.2.0 `lang()` was soft-deprecated and renamed to #' `call2()`. #' #' In early versions of rlang calls were called "language" objects in #' order to follow the R type nomenclature as returned by #' [base::typeof()]. The goal was to avoid adding to the confusion #' between S modes and R types. With hindsight we find it is better to #' use more meaningful type names. #' #' @param .fn Function to call. Must be a callable object: a string, #' symbol, call, or a function. #' @param ... Arguments to the call either in or out of a list. These dots #' support [tidy dots][tidy-dots] features. #' @param .ns Namespace with which to prefix `.fn`. Must be a string #' or symbol. #' @seealso call_modify #' @export #' @examples #' # fn can either be a string, a symbol or a call #' call2("f", a = 1) #' call2(quote(f), a = 1) #' call2(quote(f()), a = 1) #' #' #' Can supply arguments individually or in a list #' call2(quote(f), a = 1, b = 2) #' call2(quote(f), splice(list(a = 1, b = 2))) #' #' # Creating namespaced calls: #' call2("fun", arg = quote(baz), .ns = "mypkg") call2 <- function(.fn, ..., .ns = NULL) { if (is_character(.fn)) { if (length(.fn) != 1) { abort("`.fn` must be a length 1 string") } .fn <- sym(.fn) } else if (!is_callable(.fn)) { abort("Can't create call to non-callable object") } if (!is_null(.ns)) { .fn <- new_call(namespace_sym, pairlist(sym(.ns), .fn)) } new_call(.fn, as.pairlist(dots_list(...))) } #' Is an object callable? #' #' A callable object is an object that can appear in the function #' position of a call (as opposed to argument position). This includes #' [symbolic objects][is_symbolic] that evaluate to a function or #' literal functions embedded in the call. #' #' Note that strings may look like callable objects because #' expressions of the form `"list"()` are valid R code. However, #' that's only because the R parser transforms strings to symbols. It #' is not legal to manually set language heads to strings. #' #' @param x An object to test. #' @export #' @examples #' # Symbolic objects and functions are callable: #' is_callable(quote(foo)) #' is_callable(base::identity) #' #' # node_poke_car() lets you modify calls without any checking: #' lang <- quote(foo(10)) #' node_poke_car(lang, get_env()) #' #' # Use is_callable() to check an input object is safe to put as CAR: #' obj <- base::identity #' #' if (is_callable(obj)) { #' lang <- node_poke_car(lang, obj) #' } else { #' abort("`obj` must be callable") #' } #' #' eval_bare(lang) is_callable <- function(x) { is_symbolic(x) || is_function(x) } #' Is object a call? #' #' This function tests if `x` is a [call][call2]. This is a #' pattern-matching predicate that returns `FALSE` if `name` and `n` #' are supplied and the call does not match these properties. #' `is_unary_call()` and `is_binary_call()` hardcode `n` to 1 and 2. #' #' #' @section Life cycle: #' #' `is_lang()` has been soft-deprecated and renamed to `is_call()` in #' rlang 0.2.0 and similarly for `is_unary_lang()` and #' `is_binary_lang()`. This renaming follows the general switch from #' "language" to "call" in the rlang type nomenclature. See lifecycle #' section in [call2()]. #' #' @param x An object to test. If a formula, the right-hand side is #' extracted. #' @param name An optional name that the call should match. It is #' passed to [sym()] before matching. This argument is vectorised #' and you can supply a vector of names to match. In this case, #' `is_call()` returns `TRUE` if at least one name matches. #' @param n An optional number of arguments that the call should #' match. #' @param ns The namespace of the call. If `NULL`, the namespace #' doesn't participate in the pattern-matching. If an empty string #' `""` and `x` is a namespaced call, `is_call()` returns #' `FALSE`. If any other string, `is_call()` checks that `x` is #' namespaced within `ns`. #' @seealso [is_expression()] #' @export #' @examples #' is_call(quote(foo(bar))) #' #' # You can pattern-match the call with additional arguments: #' is_call(quote(foo(bar)), "foo") #' is_call(quote(foo(bar)), "bar") #' is_call(quote(foo(bar)), quote(foo)) #' #' # Match the number of arguments with is_call(): #' is_call(quote(foo(bar)), "foo", 1) #' is_call(quote(foo(bar)), "foo", 2) #' #' #' # By default, namespaced calls are tested unqualified: #' ns_expr <- quote(base::list()) #' is_call(ns_expr, "list") #' #' # You can also specify whether the call shouldn't be namespaced by #' # supplying an empty string: #' is_call(ns_expr, "list", ns = "") #' #' # Or if it should have a namespace: #' is_call(ns_expr, "list", ns = "utils") #' is_call(ns_expr, "list", ns = "base") #' #' #' # The name argument is vectorised so you can supply a list of names #' # to match with: #' is_call(quote(foo(bar)), c("bar", "baz")) #' is_call(quote(foo(bar)), c("bar", "foo")) #' is_call(quote(base::list), c("::", ":::", "$", "@")) is_call <- function(x, name = NULL, n = NULL, ns = NULL) { if (typeof(x) != "language") { return(FALSE) } if (!is_null(ns)) { if (identical(ns, "") && is_namespaced_call(x, private = FALSE)) { return(FALSE) } else if (!is_namespaced_call(x, ns, private = FALSE)) { return(FALSE) } } x <- call_unnamespace(x) if (!is_null(name)) { # Wrap language objects in a list if (!is_vector(name)) { name <- list(name) } unmatched <- TRUE for (elt in name) { if (identical(x[[1]], sym(elt))) { unmatched <- FALSE break } } if (unmatched) { return(FALSE) } } if (!is_null(n) && !has_length(x, n + 1L)) { return(FALSE) } TRUE } #' Modify the arguments of a call #' #' #' @section Life cycle: #' #' In rlang 0.2.0, `lang_modify()` was soft-deprecated and renamed to #' `call_modify()`. See lifecycle section in [call2()] for more about #' this change. #' #' @param .call Can be a call, a formula quoting a call in the #' right-hand side, or a frame object from which to extract the call #' expression. #' @param ... Named or unnamed expressions (constants, names or calls) #' used to modify the call. Use `NULL` to remove arguments. These #' dots support [tidy dots][tidy-dots] features. #' @param .standardise If `TRUE`, the call is standardised beforehand #' to match existing unnamed arguments to their argument names. This #' prevents new named arguments from accidentally replacing original #' unnamed arguments. #' @param .env The environment where to find the `call` definition in #' case `call` is not wrapped in a quosure. This is passed to #' `call_standardise()` if `.standardise` is `TRUE`. #' #' @return A quosure if `.call` is a quosure, a call otherwise. #' @seealso lang #' @export #' @examples #' call <- quote(mean(x, na.rm = TRUE)) #' #' # Modify an existing argument #' call_modify(call, na.rm = FALSE) #' call_modify(call, x = quote(y)) #' #' # Remove an argument #' call_modify(call, na.rm = NULL) #' #' # Add a new argument #' call_modify(call, trim = 0.1) #' #' # Add an explicit missing argument #' call_modify(call, na.rm = quote(expr = )) #' #' # Supply a list of new arguments with `!!!` #' newargs <- list(na.rm = NULL, trim = 0.1) #' call_modify(call, !!! newargs) #' #' # Supply a call frame to extract the frame expression: #' f <- function(bool = TRUE) { #' call_modify(call_frame(), splice(list(bool = FALSE))) #' } #' f() #' #' #' # You can also modify quosures inplace: #' f <- quo(matrix(bar)) #' call_modify(f, quote(foo)) call_modify <- function(.call, ..., .standardise = FALSE, .env = caller_env()) { args <- dots_list(...) if (any(duplicated(names(args)) & names(args) != "")) { abort("Duplicate arguments") } if (.standardise) { expr <- get_expr(call_standardise(.call, env = .env)) } else { expr <- get_expr(.call) } # Named arguments can be spliced by R named <- have_name(args) for (nm in names(args)[named]) { expr[[nm]] <- args[[nm]] } if (any(!named)) { # Duplicate list structure in case it wasn't before if (!any(named)) { expr <- duplicate(expr, shallow = TRUE) } remaining_args <- as.pairlist(args[!named]) expr <- node_append(expr, remaining_args) } set_expr(.call, expr) } #' Standardise a call #' #' This is essentially equivalent to [base::match.call()], but with #' experimental handling of primitive functions. #' #' #' @section Life cycle: #' #' In rlang 0.2.0, `lang_standardise()` was soft-deprecated and #' renamed to `call_standardise()`. See lifecycle section in [call2()] #' for more about this change. #' #' @param call Can be a call or a quosure that wraps a call. #' @param env The environment where to find the definition of the #' function quoted in `call` in case `call` is not wrapped in a #' quosure. #' #' @return A quosure if `call` is a quosure, a raw call otherwise. #' @export call_standardise <- function(call, env = caller_env()) { expr <- get_expr(call) if (is_frame(call)) { fn <- call$fn } else { # The call name might be a literal, not necessarily a symbol env <- get_env(call, env) fn <- eval_bare(node_car(expr), env) } matched <- match.call(as_closure(fn), expr) set_expr(call, matched) } #' Extract function from a call #' #' If a frame or formula, the function will be retrieved from the #' associated environment. Otherwise, it is looked up in the calling #' frame. #' #' #' @section Life cycle: #' #' In rlang 0.2.0, `lang_fn()` was soft-deprecated and renamed to #' `call_fn()`. See lifecycle section in [call2()] for more about this #' change. #' #' @inheritParams call_standardise #' @export #' @seealso [call_name()] #' @examples #' # Extract from a quoted call: #' call_fn(quote(matrix())) #' call_fn(quo(matrix())) #' #' # Extract the calling function #' test <- function() call_fn(call_frame()) #' test() call_fn <- function(call, env = caller_env()) { if (is_frame(call)) { return(call$fn) } expr <- get_expr(call) env <- get_env(call, env) if (!is_call(expr)) { abort("`call` must quote a call") } switch_lang(expr, recursive = abort("`call` does not call a named or inlined function"), inlined = node_car(expr), named = , namespaced = , eval_bare(node_car(expr), env) ) } #' Extract function name of a call #' #' #' @section Life cycle: #' #' In rlang 0.2.0, `lang_name()` was soft-deprecated and renamed to #' `call_name()`. See lifecycle section in [call2()] for more about this #' change. #' #' @inheritParams call_standardise #' @return A string with the function name, or `NULL` if the function #' is anonymous. #' @seealso [call_fn()] #' @export #' @examples #' # Extract the function name from quoted calls: #' call_name(quote(foo(bar))) #' call_name(quo(foo(bar))) #' #' # Or from a frame: #' foo <- function(bar) call_name(call_frame()) #' foo(bar) #' #' # Namespaced calls are correctly handled: #' call_name(~base::matrix(baz)) #' #' # Anonymous and subsetted functions return NULL: #' call_name(quote(foo$bar())) #' call_name(quote(foo[[bar]]())) #' call_name(quote(foo()())) call_name <- function(call) { call <- get_expr(call) if (!is_call(call)) { abort("`call` must be a call or must wrap a call (e.g. in a quosure)") } switch_lang(call, named = as_string(node_car(call)), namespaced = as_string(node_cadr(node_cdar(call))), NULL ) } #' Extract arguments from a call #' #' @section Life cycle: #' #' In rlang 0.2.0, `lang_args()` and `lang_args_names()` were #' soft-deprecated and renamed to `call_args()` and #' `call_args_names()`. See lifecycle section in [call2()] for more #' about this change. #' #' @inheritParams call_standardise #' @return A named list of arguments. #' @seealso [fn_fmls()] and [fn_fmls_names()] #' @export #' @examples #' call <- quote(f(a, b)) #' #' # Subsetting a call returns the arguments converted to a language #' # object: #' call[-1] #' #' # On the other hand, call_args() returns a regular list that is #' # often easier to work with: #' str(call_args(call)) #' #' # When the arguments are unnamed, a vector of empty strings is #' # supplied (rather than NULL): #' call_args_names(call) call_args <- function(call) { call <- get_expr(call) args <- as.list(call[-1]) set_names((args), names2(args)) } #' @rdname call_args #' @export call_args_names <- function(call) { call <- get_expr(call) names2(call[-1]) } is_qualified_call <- function(x) { if (typeof(x) != "language") return(FALSE) is_qualified_symbol(node_car(x)) } is_namespaced_call <- function(x, ns = NULL, private = NULL) { if (typeof(x) != "language") return(FALSE) if (!is_namespaced_symbol(node_car(x), ns, private)) return(FALSE) TRUE } # Returns a new call whose CAR has been unqualified call_unnamespace <- function(x) { if (is_namespaced_call(x)) { call <- call2(node_cadr(node_cdar(x))) node_poke_cdr(call, node_cdr(x)) } else { x } } # Qualified and namespaced symbols are actually calls is_qualified_symbol <- function(x) { if (typeof(x) != "language") return(FALSE) head <- node_cadr(node_cdr(x)) if (typeof(head) != "symbol") return(FALSE) qualifier <- node_car(x) identical(qualifier, namespace_sym) || identical(qualifier, namespace2_sym) || identical(qualifier, dollar_sym) || identical(qualifier, at_sym) } is_namespaced_symbol <- function(x, ns = NULL, private = NULL) { if (typeof(x) != "language") return(FALSE) if (!is_null(ns) && !identical(node_cadr(x), sym(ns))) return(FALSE) head <- node_car(x) if (is_null(private)) { identical(head, namespace_sym) || identical(head, namespace2_sym) } else if (private) { identical(head, namespace2_sym) } else { identical(head, namespace_sym) } } which_operator <- function(call) { .Call(rlang_which_operator, call) } call_has_precedence <- function(call, parent_call, side = NULL) { .Call(rlang_call_has_precedence, call, parent_call, side) } rlang/R/vec.R0000644000176200001440000000241513241233650012457 0ustar liggesusers#' Poke values into a vector #' #' These tools are for R experts only. They copy elements from `y` #' into `x` by mutation. You should only do this if you own `x`, #' i.e. if you have created it or if you are certain that it doesn't #' exist in any other context. Otherwise you might create unintended #' side effects that have undefined consequences. #' #' @param x The destination vector. #' @param start The index indicating where to start modifying `x`. #' @param y The source vector. #' @param from The index indicating where to start copying from `y`. #' @param n How many elements should be copied from `y` to `x`. #' @param to The index indicating the end of the range to copy from `y`. #' #' @keywords internal #' @export vec_poke_n <- function(x, start, y, from = 1L, n = length(y)) { stopifnot( is_integerish(start), is_integerish(from), is_integerish(n) ) .Call(rlang_vec_poke_n, x, start, y, from, n) } #' @rdname vec_poke_n #' @export vec_poke_range <- function(x, start, y, from = 1L, to = length(y) - from + 1L) { stopifnot( is_integerish(start), is_integerish(from), is_integerish(to) ) .Call(rlang_vec_poke_range, x, start, y, from, to) } rlang/R/quasiquotation.R0000644000176200001440000002420613241233650014772 0ustar liggesusers#' Quasiquotation of an expression #' #' @description #' #' Quasiquotation is the mechanism that makes it possible to program #' flexibly with tidy evaluation grammars like dplyr. It is enabled in #' all tidyeval quoting functions, the most fundamental of which are #' [quo()] and [expr()]. #' #' Quasiquotation is the combination of quoting an expression while #' allowing immediate evaluation (unquoting) of part of that #' expression. We provide both syntactic operators and functional #' forms for unquoting. #' #' - The `!!` operator unquotes its argument. It gets evaluated #' immediately in the surrounding context. #' #' - The `!!!` operator unquotes and splices its argument. The #' argument should represents a list or a vector. Each element will #' be embedded in the surrounding call, i.e. each element is #' inserted as an argument. If the vector is named, the names are #' used as argument names. #' #' Use `qq_show()` to experiment with quasiquotation or debug the #' effect of unquoting operators. `qq_show()` quotes its input, #' processes unquoted parts, and prints the result with #' [expr_print()]. This expression printer has a clearer output than #' the base R printer (see the [documentation topic][expr_print]). #' #' #' @section Unquoting names: #' #' When a function takes multiple named arguments #' (e.g. `dplyr::mutate()`), it is difficult to supply a variable as #' name. Since the LHS of `=` is quoted, giving the name of a variable #' results in the argument having the name of the variable rather than #' the name stored in that variable. This problem is right up the #' alley for the unquoting operator `!!`. If you were able to unquote #' the variable when supplying the name, the argument would be named #' after the content of that variable. #' #' Unfortunately R is very strict about the kind of expressions #' supported on the LHS of `=`. This is why we have made the more #' flexible `:=` operator an alias of `=`. You can use it to supply #' names, e.g. `a := b` is equivalent to `a = b`. Since its syntax is #' more flexible you can unquote on the LHS: #' #' ``` #' name <- "Jane" #' #' dots_list(!!name := 1 + 2) #' exprs(!!name := 1 + 2) #' quos(!!name := 1 + 2) #' ``` #' #' Like `=`, the `:=` operator expects strings or symbols on its LHS. #' #' #' @section Theory: #' #' Formally, `quo()` and `expr()` are quasiquote functions, `!!` is #' the unquote operator, and `!!!` is the unquote-splice operator. #' These terms have a rich history in Lisp languages, and live on in #' modern languages like #' [Julia](https://docs.julialang.org/en/stable/manual/metaprogramming/) #' and #' [Racket](https://docs.racket-lang.org/reference/quasiquote.html). #' #' #' @section Life cycle: #' #' * Calling `UQ()` and `UQS()` with the rlang namespace qualifier is #' soft-deprecated as of rlang 0.2.0. Just use the unqualified forms #' instead. #' #' Supporting namespace qualifiers complicates the implementation of #' unquotation and is misleading as to the nature of unquoting #' operators (these are syntactic operators that operates at #' quotation-time rather than function calls at evaluation-time). #' #' * `UQ()` and `UQS()` were soft-deprecated in rlang 0.2.0 in order #' to make the syntax of quasiquotation more consistent. The prefix #' forms are now \code{`!!`()} and \code{`!!!`()} which is #' consistent with other R operators (e.g. \code{`+`(a, b)} is the #' prefix form of `a + b`). #' #' Note that the prefix forms are not as relevant as before because #' `!!` now has the right operator precedence, i.e. the same as #' unary `-` or `+`. It is thus safe to mingle it with other #' operators, e.g. `!!a + !!b` does the right thing. In addition the #' parser now strips one level of parentheses around unquoted #' expressions. This way `(!!"foo")(...)` expands to `foo(...)`. #' These changes make the prefix forms less useful. #' #' Finally, the named functional forms `UQ()` and `UQS()` were #' misleading because they suggested that existing knowledge about #' functions is applicable to quasiquotation. This was reinforced by #' the visible definitions of these functions exported by rlang and #' by the tidy eval parser interpreting `rlang::UQ()` as `!!`. In #' reality unquoting is *not* a function call, it is a syntactic #' operation. The operator form makes it clearer that unquoting is #' special. #' #' * `UQE()` was deprecated in rlang 0.2.0 in order to make the is #' deprecated in order to simplify the quasiquotation syntax. You #' can replace its use by a combination of `!!` and `get_expr()`. #' E.g. `!! get_expr(x)` is equivalent to `UQE(x)`. #' #' * The use of `:=` as alias of `~` is defunct as of rlang 0.2.0. It #' caused surprising results when invoked in wrong places. For #' instance in the expression `dots_list(name := 1)` this operator #' was interpreted as a synonym to `=` that supports quasiquotation, #' but not in `dots_list(list(name := 1))`. Since `:=` was an alias #' for `~` the inner list would contain formula-like object. This #' kind of mistakes now trigger an error. #' #' @param x An expression to unquote. #' @name quasiquotation #' @aliases UQ UQE UQS #' @examples #' # Quasiquotation functions quote expressions like base::quote() #' quote(how_many(this)) #' expr(how_many(this)) #' quo(how_many(this)) #' #' # In addition, they support unquoting. Let's store symbols #' # (i.e. object names) in variables: #' this <- sym("apples") #' that <- sym("oranges") #' #' # With unquotation you can insert the contents of these variables #' # inside the quoted expression: #' expr(how_many(!!this)) #' expr(how_many(!!that)) #' #' # You can also insert values: #' expr(how_many(!!(1 + 2))) #' quo(how_many(!!(1 + 2))) #' #' #' # Note that when you unquote complex objects into an expression, #' # the base R printer may be a bit misleading. For anstance compare #' # the output of `expr()` and `quo()` (which uses a custom printer) #' # when we unquote an integer vector: #' expr(how_many(!!(1:10))) #' quo(how_many(!!(1:10))) #' #' # This is why it's often useful to use qq_show() to examine the #' # result of unquotation operators. It uses the same printer as #' # quosures but does not return anything: #' qq_show(how_many(!!(1:10))) #' #' #' # Use `!!!` to add multiple arguments to a function. Its argument #' # should evaluate to a list or vector: #' args <- list(1:3, na.rm = TRUE) #' quo(mean(!!!args)) #' #' # You can combine the two #' var <- quote(xyz) #' extra_args <- list(trim = 0.9, na.rm = TRUE) #' quo(mean(!!var , !!!extra_args)) #' #' #' # The plural versions have support for the `:=` operator. #' # Like `=`, `:=` creates named arguments: #' quos(mouse1 := bernard, mouse2 = bianca) #' #' # The `:=` is mainly useful to unquote names. Unlike `=` it #' # supports `!!` on its LHS: #' var <- "unquote me!" #' quos(!!var := bernard, mouse2 = bianca) #' #' #' # All these features apply to dots captured by enquos(): #' fn <- function(...) enquos(...) #' fn(!!! args, !!var := penny) #' #' #' # Unquoting is especially useful for building an expression by #' # expanding around a variable part (the unquoted part): #' quo1 <- quo(toupper(foo)) #' quo1 #' #' quo2 <- quo(paste(!!quo1, bar)) #' quo2 #' #' quo3 <- quo(list(!!quo2, !!!syms(letters[1:5]))) #' quo3 NULL #' @rdname quasiquotation #' @export UQ <- function(x) { abort("`UQ()` can only be used within a quasiquoted argument") } #' @rdname quasiquotation #' @export UQE <- function(x) { warn("`UQE()` is deprecated. Please use `!! get_expr(x)`") abort("`UQE()` can only be used within a quasiquoted argument") } #' @rdname quasiquotation #' @export UQS <- function(x) { abort("`UQS()` can only be used within a quasiquoted argument") } #' @rdname quasiquotation #' @export `!!` <- function(x) { abort("`!!` can only be used within a quasiquoted argument") } #' @rdname quasiquotation #' @export #' @usage NULL `!!!` <- function(x) { abort("`!!!` can only be used within a quasiquoted argument") } #' @rdname quasiquotation #' @param y An R expression that will be given the argument name #' supplied to `x`. #' @export `:=` <- function(x, y) { abort("`:=` can only be used within a quasiquoted argument") } #' @rdname quasiquotation #' @param expr An expression to be quasiquoted. #' @export qq_show <- function(expr) { expr_print(enexpr(expr)) } #' Process unquote operators in a captured expression #' #' While all capturing functions in the tidy evaluation framework #' perform unquote on capture (most notably [quo()]), #' `expr_interp()` manually processes unquoting operators in #' expressions that are already captured. `expr_interp()` should be #' called in all user-facing functions expecting a formula as argument #' to provide the same quasiquotation functionality as NSE functions. #' #' @param x A function, raw expression, or formula to interpolate. #' @param env The environment in which unquoted expressions should be #' evaluated. By default, the formula or closure environment if a #' formula or a function, or the current environment otherwise. #' @export #' @examples #' # All tidy NSE functions like quo() unquote on capture: #' quo(list(!!(1 + 2))) #' #' # expr_interp() is meant to provide the same functionality when you #' # have a formula or expression that might contain unquoting #' # operators: #' f <- ~list(!!(1 + 2)) #' expr_interp(f) #' #' # Note that only the outer formula is unquoted (which is a reason #' # to use expr_interp() as early as possible in all user-facing #' # functions): #' f <- ~list(~!!(1 + 2), !!(1 + 2)) #' expr_interp(f) #' #' #' # Another purpose for expr_interp() is to interpolate a closure's #' # body. This is useful to inline a function within another. The #' # important limitation is that all formal arguments of the inlined #' # function should be defined in the receiving function: #' other_fn <- function(x) toupper(x) #' #' fn <- expr_interp(function(x) { #' x <- paste0(x, "_suffix") #' !!! body(other_fn) #' }) #' fn #' fn("foo") expr_interp <- function(x, env = NULL) { if (is_formula(x)) { f_rhs(x) <- .Call(rlang_interp, f_rhs(x), env %||% f_env(x)) } else if (is_closure(x)) { body(x) <- .Call(rlang_interp, body(x), env %||% fn_env(x)) } else { x <- .Call(rlang_interp, x, env %||% parent.frame()) } x } rlang/README.md0000644000176200001440000000354313242736060012644 0ustar liggesusersrlang ======================================================= [![Build Status](https://travis-ci.org/r-lib/rlang.svg?branch=master)](https://travis-ci.org/r-lib/rlang) [![Coverage Status](https://codecov.io/gh/r-lib/rlang/branch/master/graph/badge.svg)](https://codecov.io/github/r-lib/rlang?branch=master) **Important**: The rlang API is still maturing. Please see `?rlang::lifecycle` for the list of functions that are considered stable. ## Overview The rlang package provides tools to work with core language features of R and the tidyverse: * The __tidy eval__ framework, which is a well-founded system for non-standard evaluation built on quasiquotation (`!!`) and quosures (`quo()`). * Consistent tools for working with base types. Note that overall this is a work in progress that is still in flux: * Vectors, including construction (`lgl()`, `int()`, ...) coercion (`as_logical()`, `as_character()`, ...), and predicates (`is_logical()`, `is_character()`). * Language objects, such as calls (`lang()`) and symbols (`sym()`). * Attributes, e.g. `set_names()`. * Functions, e.g. `new_function()`, `as_function()`. The latter supports the purrr-style formula notation for lambda functions. * Environments, e.g. `env()`, `env_has()`, `env_get()`, `env_bind()`, `env_unbind()`. * A comprehensive set of predicates to determine if an object satisfies various conditions, e.g. `has_length()`, `is_list()`, `is_empty()`. * The condition (message, warning, error) and restart system. ## Installation You can install the released version of rlang from CRAN with: ```r install.packages("rlang") ``` Or install the development version from github with: ```r # install.packages("devtools") devtools::install_github("r-lib/rlang", build_vignettes = TRUE) ``` rlang/MD50000644000176200001440000004115013242771563011700 0ustar liggesuserse4296a50d108683a10e69302417d8076 *DESCRIPTION 8986989469c97882d531b6b6505469fd *NAMESPACE 4f64240a409e79d7d791befdb7addf21 *NEWS.md a8c92e452b5010861f5bf7e1ace18d3a *R/arg.R a9f036d8e6cf5329f46722c7eab184e2 *R/attr.R 404489e89c81bb0e95ac88f34be8c653 *R/c-api.R 555137201680ce4eb8eb6040bb2e53de *R/call.R 9ca16101cb63e949761361a94b3986a8 *R/cnd-handlers.R 7f7d7b5557412d8bcdb26fcd86fe5861 *R/cnd-restarts.R 31d2b52cf95165598f9d0fe9b7a10d11 *R/cnd.R a7a5cbcf5951a697ddc1b911384f8c7e *R/compat-lazyeval.R 552b6c37e0f78fa99b9233101a2c59f7 *R/compat-oldrel.R afa8a7130b89cd22138abd9514870d10 *R/compat-purrr.R 7a107a600ad4998c870ac1af4f567f59 *R/deparse.R 5a4fdb0fc1ae77b5ce8bbeda299d6145 *R/dots.R 034f0485ed01cbb9f102d58e893ffec8 *R/env.R abd194d4fc462440c4a98348eef8e68a *R/eval-tidy.R c2d1681de54899796acd167222767332 *R/eval.R 7b5f716c41f149eb0f387cf04dde2f6f *R/events.R 8cabc6032d86a284717fa8f280c857b7 *R/expr.R 21d10aa7c8b22cee476e0b5d64f80f5d *R/fn.R a45af14e69963f929ba5d75387d29340 *R/formula.R bcf656db29e7b8b8ec91bea7199c153f *R/lifecycle-retired.R fe967dcf7459166b19427e29049ba95d *R/lifecycle.R d43ba69573c3b2954c12504ae0a02604 *R/node.R 63c0e5c413779fad6aae8aa6aae2a6e2 *R/operators.R 079a1b6711fe19b0b0b6022f9f8b117f *R/parse.R 246a035a94a6ffb814e31aba214d9246 *R/quasiquotation.R 962d1bd2424c35f3b582afe9a3a2f554 *R/quo.R ec37be9219e8bb7ba00573b9b3424c29 *R/quotation.R bcfba7af94a1169d2af0ef4bdc097d13 *R/rlang.R 563a2ea0e9c96916611bfd84d1257a16 *R/s3.R 8cb841f2d61becaf86bfc1aed53a3fb7 *R/sexp.R bcecd3d188d38379840a197bfe4b316c *R/stack.R 3c751828af328615b123946360c46954 *R/state.R b3509d73d5fd9821b4250cd0dac37afd *R/sym.R c72d6a316a2b96e16030568e2f5321d7 *R/types.R 514efce1b2ed162cad0602ae25f85ae9 *R/utils.R 0e91abf7c72225c102cbe6bb6f35acd8 *R/vec-bytes.R 1a2d63742c25a9d1715d948baa330d17 *R/vec-chr.R 8a16ebd24dba0f7f1fb0447d8c422312 *R/vec-coerce.R e82ee8f9c7c092d72fef95fb9c1d8744 *R/vec-na.R 2a65341dc49c613e170b63b3b1df080a *R/vec-new.R 70286a6a595e3ed3ffdc688bd48a143e *R/vec-squash.R f00af6c6726ec0e96a50af7cb747e02f *R/vec-utils.R 92b06300bec98bc6fa98d2250bcfdb9a *R/vec.R 83d4a79e564cf0489bb5085e0d3eb5dc *README.md 73c52e0da3c58ad9035e9dff20948a56 *man/abort.Rd 8cdb7ebd16edb2c45c069202e18c031d *man/are_na.Rd 5691903ed6051a10cb885b822c0581dd *man/arg_match.Rd c81cbb71be52c646dd46964f3434f3f8 *man/as_bytes.Rd 173e624eccdf6c726913095d291385a7 *man/as_data_mask.Rd e48d4d8426261eb2a1354eccad604df6 *man/as_env.Rd 5ae8ea917a2464da9341b4b26503bf5e *man/as_environment.Rd c7eddce33858963eb91890a7bec67b03 *man/as_function.Rd f4d1b2d50c468f7f792a17eee6b45207 *man/as_overscope.Rd 865c093d4787c7b6b4606e1edeef8380 *man/as_pairlist.Rd e147140c1865bf836f00a0be0b5cfb50 *man/as_quosure.Rd 9a5e9c323519522028c5341eb8316da8 *man/as_utf8_character.Rd 4e296349bd26886f15acbdc7bb529440 *man/bare-type-predicates.Rd 1842a796caacc13118ce334b19d978fe *man/box.Rd 3e86c88550fe300bc8e8cc3d60ac7012 *man/call2.Rd 8cff8bde73de5868f236fc21f5d6d0a1 *man/call_args.Rd 20df06aabda26e2aeb13173a14baafff *man/call_fn.Rd c7cfdb4ad9aa7a51c353929a6200b7b3 *man/call_inspect.Rd 0768e2a3fca906bc0c11200d31e0bb99 *man/call_modify.Rd 80d9120f2a9f60776a03e1d9d9fd79e7 *man/call_name.Rd 24a14b7bab0a9f782536018e39c712b5 *man/call_standardise.Rd 9d1676818446110973cd3a7a4c9ae348 *man/caller_env.Rd 64e5869d0445da14cc0df545e3c92d00 *man/catch_cnd.Rd 0efa197942784862b16c434f97cfdca6 *man/chr_unserialise_unicode.Rd 551c1d3cbe8bf632ee17655b76289587 *man/cnd.Rd 9a1417b9ddf3229b2c8ddfb3058bfcff *man/cnd_signal.Rd 262c3cc6cddd69988354c77becd2b44e *man/deprecated-cnd.Rd 96a243c5bbc5bb31579a6532c1d28626 *man/dictionary.Rd 737aba076690342338666eee39d32c46 *man/dots_definitions.Rd ab9a67f908943873763d03995ee59413 *man/dots_n.Rd f86b1e5f890ba19d912f231f53e8aa16 *man/dots_values.Rd 4b66b7c96cce36b4dc597c5b380aee7b *man/duplicate.Rd 4701438fbf7da409d2b907d0bc44686d *man/empty_env.Rd 6c817760ff2adc2745d65d5ea9baa56a *man/env.Rd 563a6b9d12f7f463e2653fe33497bb56 *man/env_bind.Rd cdb9b0e5e338203b417ea45ae205a80d *man/env_bind_exprs.Rd dc29865280895ec123c927353a56e4cc *man/env_bury.Rd ae22dee7a9ea7c229935cfe5c43fcc0e *man/env_clone.Rd 8fe8fe98b75288eee5810935549893f6 *man/env_depth.Rd 3ac834c0af15685ac32cc6b0004c0fea *man/env_get.Rd 5b1cf44268c37dbe116bdecb02a0fe1f *man/env_has.Rd e579185b1e908f7ac9dc02ba2d84a1d0 *man/env_inherits.Rd 9cd23bd3e3faf0cea7f38e56acffe587 *man/env_names.Rd 0b17b5caeef612ec0508d50dd35cfc4c *man/env_parent.Rd a664dcfb3b2b274cdd186f2ed8759ca5 *man/env_poke.Rd 113b77ed25b6f76e61209ce0b17f4f2b *man/env_unbind.Rd 3357d6894bb0823bc5090d89a7875926 *man/eval_bare.Rd 0e37a25b4e7e47185792321c9932da82 *man/eval_tidy.Rd 9ee50d5df5bdff6559a12a9aa1c81313 *man/eval_tidy_.Rd bda0baef7dcab89e2bb80d7e0187d2b8 *man/exiting.Rd 9f9a454b85241763db671b9e58a097ff *man/expr_interp.Rd e0c3f575d840093dd1a6ae4d90de89d8 *man/expr_label.Rd 8ff98febc8302a5206b136c2fcc10bc5 *man/expr_print.Rd 98fae7163e47c16cc54d814129da0ed2 *man/exprs_auto_name.Rd f9fe2913a3200a2db8c3695e21b73dff *man/f_rhs.Rd fde75000d75782933733dfc1b3814540 *man/f_text.Rd 42e90e0813fee26f77866a2f8025b3ba *man/figures/rlang.png 1064a816785679836bd0da2f034dc824 *man/flatten.Rd b988421c8012be0976303a4ee80ce70f *man/fn_body.Rd fb6a9867bff132541ea3830d5707ad29 *man/fn_env.Rd 886bd3b5f3d9fd714246d54f73aef54f *man/fn_fmls.Rd 07641a3ef73addbf5dea30dfb4c36c27 *man/frame_position.Rd be276e3890c37d72323dc20c0b5eeea9 *man/friendly_type.Rd 64288012846af025f30c73aebf951978 *man/get_env.Rd cd4eabd927b4d7f6c9d9a26338093656 *man/has_length.Rd 17cb5c536e230ed5484640deddf632d9 *man/has_name.Rd 37557bfdbf3f7a1800a6de3e451a0df4 *man/inherits_any.Rd 676515ea9252841f05a7083a9e826e2b *man/invoke.Rd 8c80184e9b1ea8cc0ed651785f827532 *man/is_call.Rd 154837f77839c6010cd9f0f6b21b37a5 *man/is_callable.Rd 409300831dc925b98eb2e63c8c26060e *man/is_condition.Rd 91d26b703dec47f81afcb896132d0f8f *man/is_copyable.Rd ab65d6e0c9ab4b2914627ef58f4995ee *man/is_empty.Rd 079abf9dab58e5170875c4a6c4d1cf48 *man/is_env.Rd 8ee91d41b4d97a939b8ad3137bdc5afe *man/is_expr.Rd 12e4d884da00e38e64ce795847e60522 *man/is_expression.Rd f1151d26fb8190d83e147f1cd9e1cc66 *man/is_formula.Rd 79037bf9e4be01f5fcf30dd21e237b3d *man/is_frame.Rd 06eae5eed20273762f208bd88a323c88 *man/is_function.Rd 528d325f118ed48392cc17c89f489eef *man/is_installed.Rd 2d16c7399c86fc0adf0e371179a65aca *man/is_integerish.Rd 406b6eabb17f9514b66f8daa3d3c1981 *man/is_lang.Rd b4888543fa7d4d715edd043863b447c5 *man/is_named.Rd 056070a64589dddbf97a6a5e23b60f6e *man/is_namespace.Rd a811ebb034918a018971346506163c43 *man/is_pairlist.Rd 1e0ed0c49500d43cb71686befda94619 *man/is_quosureish.Rd 0c54a46e99b9a03e256414f079041894 *man/is_reference.Rd ef22617e10a178f3937ce38a1d574440 *man/is_stack.Rd c457115011e6911d25e71243178f1b3e *man/is_symbol.Rd c524dae3c587048154fff2fbded9f7b9 *man/is_true.Rd 5fb6254c5b481cf2c672159734823f5e *man/lang.Rd 44969037af44167110a02ff2a27259dd *man/lang_head.Rd 76225a09369c23c76927c3116bad31b1 *man/lang_modify.Rd 642ccbab48c3db4a588bc96716765e05 *man/lifecycle.Rd 7ac7ca248503ef3735244e330d894478 *man/missing.Rd 443fa013af23342fe4259d032dcc539c *man/missing_arg.Rd d8fb35531f78f0d1c7820bb47006f21d *man/modify.Rd ce0c874cc854ab9c75acef06232b2785 *man/mut_node_car.Rd 23d7c98b13113b6cd9bd83ecd9d30e33 *man/mut_utf8_locale.Rd 570b40d6ee6e7f1d4832e5662775b524 *man/names2.Rd 8b0802436e9adc0e3a8c1cc2c8d02e96 *man/new-vector-along.Rd 8ffe510b4bd912bbe2fa1c82bbb44624 *man/new-vector.Rd f5df9b04102726b56a6e208a9d3467ae *man/new_call.Rd 2ad8783d26be37103f821e5ae535c56b *man/new_formula.Rd bf23badb442e4f675d0a1a3ea423980e *man/new_function.Rd 34d6549506d57f9c01f5cc5be8f728c2 *man/new_node.Rd ad808bc131f213fd587260be40a345a9 *man/ns_env.Rd 7b1a95232bf259e3aa002390e456d2a7 *man/op-definition.Rd 25968838703a8a2fa53e74a7c65ba972 *man/op-get-attr.Rd 375233489e5c5afe90c40ea4c78dda33 *man/op-na-default.Rd 104a6a1976e8c95b00c7f5f3457ba6d7 *man/op-null-default.Rd 4fb7b3487325758adbf66513d2929208 *man/overscope_eval_next.Rd a93d301d202b1bf6665b987e777feea2 *man/parse_expr.Rd 5a4ae4a79c6386cac30e8c546374ddf0 *man/parse_quosure.Rd 63bfcd9c1fcd94d694238e92867ce6f3 *man/prepend.Rd 90d2aca5c08c6285fa1eb36f4445d685 *man/prim_name.Rd a6304c4ca4725118027324ba8a4544db *man/quasiquotation.Rd 4e5bf4fd82a3225209ac67851d08e713 *man/quo_expr.Rd f10088000fffda42b54ebb7c67a645ef *man/quo_label.Rd 4e27ad6ca873caee985d124ff422cbe9 *man/quo_squash.Rd 40b892844183806fb7405e7235edf230 *man/quosure.Rd 04d3a0e3c681c8b01ea01e2fd1b61765 *man/quotation.Rd 7af3f9895d33f33e8fdd2183f0f2e38b *man/restarting.Rd 531e6ae4b28c94bf17d78d6493e3d97f *man/return_from.Rd 98a7585f070be151686b231f308ecc3e *man/rst_abort.Rd 0868a3e90d95ce6ce970e83a360bb01f *man/rst_list.Rd d14da9436c6344cdc75918b955486c7f *man/rst_muffle.Rd 3ba96b24fec2e0677e8b352599bd37d2 *man/scalar-type-predicates.Rd e550b27e9e1b34185bf9a25c9145b94d *man/scoped_bindings.Rd 6e795904e3a0647e0e376bc6a0388551 *man/scoped_env.Rd 7c6921205693a6e919f275015236858c *man/scoped_options.Rd 631daf14914e8516bc3d613b05e6b4e2 *man/seq2.Rd 1e85b4946783c9af1fe7a0e7b6ec99bb *man/set_attrs.Rd 71440fcdc88c2330174d806bfdffadb5 *man/set_chr_encoding.Rd 34595dfb7e8fefad12dd8d6a0ae4ec62 *man/set_expr.Rd 3650008c6bad74b25e56a35150c3b1c6 *man/set_names.Rd 6dc30a100c7358c2a8f6441153d895bc *man/splice.Rd 87c5da403fcb544b22bccd5a98bff42b *man/stack.Rd 28f175ccd9e1cde924e4aca5b664f902 *man/stack_trim.Rd 6568027ac2b2a3818b284dee93a7adc2 *man/string.Rd 09d7ffcedeb36290f3f72265bcd6b5d6 *man/switch_lang.Rd 293efcfb4d1d872b5529d7d90c7fb364 *man/switch_type.Rd 2706c0f4f67cb3931583aace7db3bbaa *man/sym.Rd 0d75bd5b008c60dbd7a8116592fb5a9a *man/tidy-dots.Rd bf1e5c4252cbe5c3df53204af4bac01f *man/tidyeval-data.Rd c4d4b53dc4feffb152cc00fead8463d8 *man/type-predicates.Rd e9af9e667ee845985f7ac179e10b9f18 *man/type_of.Rd cca435a2fd60cfa4526bcd53f7e75222 *man/vec_poke_n.Rd 4bf84652e4f55f6cd769f0208b20e25e *man/vector-coercion.Rd 98051d2320939ec05192e2d362b0a7e6 *man/vector-construction.Rd 5001a14209452e9d77a555988baf8a05 *man/vector-old-ctors.Rd 24840dcc729515bd64c80a279af31ed7 *man/with_env.Rd 4276b74a748829a5d44c7bd030092a76 *man/with_handlers.Rd baef0a2bfaafceab310a424f60c0fd13 *man/with_restarts.Rd 05c8f3ee0da0505c57bf0a07c1b5e06d *src/Makevars 4207bede3a15215abaf8a36962c73457 *src/capture.c 372738f63854b1faa1e7dc2c3768a7b0 *src/export.c 424bca744cf6aa17004d54f07912b5d1 *src/export/exported-tests.c d30b5c981d24549cd979723001a5a17a *src/export/exported.c 914037504f00bcc667a9e33b9691ecee *src/export/init.c 9769cd4b8ef74c2e932441861bfeea4d *src/internal.c 87e61dd32ed6cb2def862f4df241125a *src/internal/arg.c 8a78c89f38598f3d780cd86c732024a3 *src/internal/dots.c d4b0254f76d5196e0823dbbcfab66320 *src/internal/dots.h 52a800260582e53cea23ce668b577da9 *src/internal/eval-tidy.c 4f59e263727c3af88c2dd0b9028673dc *src/internal/expr-interp-rotate.c d94334212a74d3d56e347d85675e5ea5 *src/internal/expr-interp-rotate.h 4fbe3b8804dadd9b06974ce38067329e *src/internal/expr-interp.c bce59b6c52a1a10029c36b8a77d22f97 *src/internal/expr-interp.h 509fc5500394ba114c49cb70953dcd41 *src/internal/internal.c ca4965bfca0410eae22cfb390c25193b *src/internal/internal.h 5b4959cf21892afafb38f5c0b7f94ed1 *src/internal/quo.c 60a81a6fbe624332ce99d756cf9c84fa *src/internal/quo.h e9a9620ab7b7491d43cec9ebfbd5afdd *src/internal/utils.c 876aa20b1762be9834c4ea62bc45ea0d *src/internal/utils.h 43afc5909482baa8ebb7ad4e338c5c27 *src/lib.c beb904363b5b7873d995dbb16533224f *src/lib/attrs.c c7c852680c71570b08310d884734a3fd *src/lib/attrs.h 4270bddc21541809a41abb22ef1cfde0 *src/lib/cnd.c b0c4f991491e8541c9b9a1aa5c426075 *src/lib/cnd.h 61240b6e58497c4c6691df5db385d2d2 *src/lib/debug.h b6fc14af43d3f2f840c85b2a3725098c *src/lib/env.c bdf0965c55e458bbf408eb8c4bdac5d2 *src/lib/env.h 504c393f53f7aac9d951bfccd1abbdd5 *src/lib/eval.c bb39269899a1647fc0d5618ceada47c7 *src/lib/eval.h 4f93b1c72a2b68597b5f1728c9504cc9 *src/lib/export.c 1a03631c5589c37239491cc41f32ea1e *src/lib/export.h b2d7dcb5dac2f7bdcf1a5568fd5f4b96 *src/lib/fn.c 99fab69e55ac24f834973d215ddf6fb0 *src/lib/fn.h f651b3a90c36f024a01fe08b6d413ef7 *src/lib/formula.c 65f6bd0f962f7a05322e1964c3d545b2 *src/lib/formula.h e2d9e062edd90f6d09885d9269cff3ac *src/lib/lang.c b974693f20efee961efe60cfa9b5d7bd *src/lib/lang.h c3c62d1bd2702d90ecb6ccf2d6b5dd49 *src/lib/node.c c9608993359a8cd849886714c780d003 *src/lib/node.h 5eed4360e25abb9ec600e2a64e0394ce *src/lib/parse.c ef65d7111b9e64247f1abe390fedc772 *src/lib/parse.h bfd369311f1b014af975e8d169090b42 *src/lib/quo.c b1395da0d9a1a6e1a0e8b96f8d122af4 *src/lib/quo.h dc6119cd6796dc8bec3d24c4dd30f066 *src/lib/replace-na.c 93c21f7ad7af49817e1b55be527c8a3d *src/lib/rlang.c 0118530a4c06ff62d039985b4bb95cd2 *src/lib/rlang.h 3d22e89d63de6dbcb53c0352ca1f5bb7 *src/lib/sexp.c 7d11a7e40ecf953e1ef093ef3977159e *src/lib/sexp.h 1afb1bf096d7ee30850ab30618f9c6b9 *src/lib/squash.c b21ec8fa3f3599696fd677b27631ab92 *src/lib/squash.h 1bacf3a10138f51fad20f5ca9b8b7f94 *src/lib/stack.c ca5ec968a58e31753b06ac34eaa04132 *src/lib/stack.h 0b96cb0ff95091cf208b92a1a0b0f095 *src/lib/state.h bde789a0f2c185be4c1cea2413796697 *src/lib/sym-unescape.c 0bc3d7a8756f36132c2a2a2b0b05192e *src/lib/sym.c 6ec56db56973396c5cd858fc7b364b8e *src/lib/sym.h ef251ebf8feb4d4e31eb6f107c0d7bc6 *src/lib/vec-chr.c 1ac89fa44d3af46331ebede968f8a84c *src/lib/vec-chr.h 304a9fbf7fc65f95f59451e7dce090d6 *src/lib/vec-lgl.c ef186a5c5a93c255643f8ff346d7bb81 *src/lib/vec-lgl.h 2e4169e36a519cb5365fcaa5d8d517d4 *src/lib/vec-list.c 011d9a53d42f0baff4b509d28de7a257 *src/lib/vec-list.h 36aee24cea3a2aaada28e3a281f6b9b5 *src/lib/vec.c 79b3493d807099c5da6771a1ebe951d4 *src/lib/vec.h d16f40ca8b10582b3cd54e3bceedd568 *tests/testthat.R 6455ea1f601fd0dc531748528f257ea1 *tests/testthat/fixtures/lib.zip 2f019c1aa291d53dec4131b8ebabcb87 *tests/testthat/fixtures/rlanglibtest/DESCRIPTION 7aab50abe7351ed88ab8802f5f80ce0e *tests/testthat/fixtures/rlanglibtest/NAMESPACE 8d0704f5c2648f3da14f385c1cb35e94 *tests/testthat/fixtures/rlanglibtest/R/rlanglibtest.R de5d6e28846d582858e06161de676531 *tests/testthat/fixtures/rlanglibtest/src/Makevars b6bead415bd9c1f9fd97b35c83f87fbf *tests/testthat/fixtures/rlanglibtest/src/init.c 7295d46696a4d41f92a5f967c65edf5a *tests/testthat/fixtures/rlanglibtest/src/test-quo-accessors.c d18d1bdcf3564ccaa3a32da5977d5787 *tests/testthat/fixtures/rlanglibtest/tests/testthat.R cf4af2dc60c747068c60d6504d34e8a8 *tests/testthat/fixtures/rlanglibtest/tests/testthat/test-quo-accessors.R b1ea240ea857c0cf45bfa72c752837c0 *tests/testthat/helper-capture.R d7f7612d15ee9cc2ca3eea42f3196833 *tests/testthat/helper-conditions.R eb6e20ea96453706b2c7a26d17128207 *tests/testthat/helper-locale.R 71d70b5fc2aa426a2918ec167f657855 *tests/testthat/helper-print.R a20ff5a7133d7e0407ccd1ea4ff6034e *tests/testthat/helper-stack.R 8b759aa010d0ebdb46372634e340b84b *tests/testthat/test-arg.R 959a44758799362d1e47d155ed833da3 *tests/testthat/test-attr.R bd1823bc6d1b717ad1516032c49edff6 *tests/testthat/test-c-api.R 47b0c06c566c43e4f19b5d64a8571cf6 *tests/testthat/test-call.R 401bef78b8d85991bf8eb2ef3a504b7a *tests/testthat/test-compat.R 09053ae73e1069ee46362e5a2424ceab *tests/testthat/test-conditions.R 6cac9258456117bd615566b4eab2e1a6 *tests/testthat/test-deparse.R 42305906379694f6458263fb7b45df0c *tests/testthat/test-dictionary.R 419289c637c9b3dc22ca8cb23aca87b8 *tests/testthat/test-dots.R 78cd8c09cd0fb0bed44e492d5894768a *tests/testthat/test-encoding.R 397b8726e94e1daff17bec9cf3f2f22b *tests/testthat/test-env.R 6739817db6ea5ea68d16e212e5756588 *tests/testthat/test-eval-tidy.R 23f0564b9101b2409f843a979b2e018b *tests/testthat/test-eval.R 5ff5d0085ce665bb3b62a577b08fdedb *tests/testthat/test-events.R 9a2555f623262a9698653b47ae75ea36 *tests/testthat/test-expr.R eadd53ab06f93df88f7bd7afb8b5d6e4 *tests/testthat/test-fn.R 5dd0063b437e2d1db6fe17e707a47ec0 *tests/testthat/test-formula.R dc0a7c19f2d687c1e9ded738e84f83f6 *tests/testthat/test-node.R 1d692c7d92461879a407b14e0447f887 *tests/testthat/test-operators.R 1eeda01cf2fcf4f2b2f4b368331b8cd9 *tests/testthat/test-parse.R 3d31fd40f1620e2508b5b982ec35b17c *tests/testthat/test-quasiquotation.R 00f4a827a7770a049d45608e4147b2ba *tests/testthat/test-quo.R 9a992ac0fd97e0e859e9091333a8ab5d *tests/testthat/test-quotation.R 25e3fb5f07af62a4573727ad365d142e *tests/testthat/test-retired.R 4a8b326cadc83c4577e442156bd29308 *tests/testthat/test-s3.R 647e7dc77cdc21fb0228177338a3b948 *tests/testthat/test-sexp.R eeed2a76fa9b6a16a8e0341ce5eea804 *tests/testthat/test-stack.R 5228dd5b85e8eafc54987a714a93517d *tests/testthat/test-state.R 6dfa3cadf109842e6da13da60c20bc51 *tests/testthat/test-sym.R 2bcb3c0ae1a445e0deaef7fe76a26008 *tests/testthat/test-types.R b473ed8e931e8173fc92bcd0deb21198 *tests/testthat/test-utils.R c83dab66f5a14e1d515de2b0ac68e5d1 *tests/testthat/test-vec-coerce.R e64d2e35715d31978ae0c0a34d7d4538 *tests/testthat/test-vec-new.R 3e97559215d4a2f05ea0e4513e4ffaa3 *tests/testthat/test-vec-squash.R d62a55e6f59ba2aa8fac9f92c3bc407c *tests/testthat/test-vec-utils.R 55881bd92e63d4846c850533de6fced6 *tests/testthat/test-vec.R rlang/DESCRIPTION0000644000176200001440000000171413242771563013100 0ustar liggesusersPackage: rlang Version: 0.2.0 Title: Functions for Base Types and Core R and 'Tidyverse' Features Description: A toolbox for working with base types, core R features like the condition system, and core 'Tidyverse' features like tidy evaluation. Authors@R: c( person("Lionel", "Henry", ,"lionel@rstudio.com", c("aut", "cre")), person("Hadley", "Wickham", ,"hadley@rstudio.com", "aut"), person("RStudio", role = "cph") ) License: GPL-3 LazyData: true ByteCompile: true Depends: R (>= 3.1.0) Suggests: crayon, knitr, methods, pillar, rmarkdown (>= 0.2.65), testthat, covr RoxygenNote: 6.0.1 URL: http://rlang.tidyverse.org, https://github.com/r-lib/rlang BugReports: https://github.com/r-lib/rlang/issues NeedsCompilation: yes Packaged: 2018-02-20 06:15:49 UTC; lionel Author: Lionel Henry [aut, cre], Hadley Wickham [aut], RStudio [cph] Maintainer: Lionel Henry Repository: CRAN Date/Publication: 2018-02-20 10:07:47 UTC rlang/man/0000755000176200001440000000000013242736425012140 5ustar liggesusersrlang/man/is_callable.Rd0000644000176200001440000000223413241233650014651 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{is_callable} \alias{is_callable} \title{Is an object callable?} \usage{ is_callable(x) } \arguments{ \item{x}{An object to test.} } \description{ A callable object is an object that can appear in the function position of a call (as opposed to argument position). This includes \link[=is_symbolic]{symbolic objects} that evaluate to a function or literal functions embedded in the call. } \details{ Note that strings may look like callable objects because expressions of the form \code{"list"()} are valid R code. However, that's only because the R parser transforms strings to symbols. It is not legal to manually set language heads to strings. } \examples{ # Symbolic objects and functions are callable: is_callable(quote(foo)) is_callable(base::identity) # node_poke_car() lets you modify calls without any checking: lang <- quote(foo(10)) node_poke_car(lang, get_env()) # Use is_callable() to check an input object is safe to put as CAR: obj <- base::identity if (is_callable(obj)) { lang <- node_poke_car(lang, obj) } else { abort("`obj` must be callable") } eval_bare(lang) } rlang/man/dots_values.Rd0000644000176200001440000000206013241304434014743 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dots.R \name{dots_values} \alias{dots_values} \title{Evaluate dots with preliminary splicing} \usage{ dots_values(..., .ignore_empty = c("trailing", "none", "all")) } \arguments{ \item{...}{Arguments to evaluate and process splicing operators.} \item{.ignore_empty}{Whether to ignore empty arguments. Can be one of \code{"trailing"}, \code{"none"}, \code{"all"}. If \code{"trailing"}, only the last argument is ignored if it is empty.} } \description{ This is a tool for advanced users. It captures dots, processes unquoting and splicing operators, and evaluates them. Unlike \code{\link[=dots_list]{dots_list()}}, it does not flatten spliced objects, instead they are attributed a \code{spliced} class (see \code{\link[=splice]{splice()}}). You can process spliced objects manually, perhaps with a custom predicate (see \code{\link[=flatten_if]{flatten_if()}}). } \examples{ dots <- dots_values(!!! list(1, 2), 3) dots # Flatten the objects marked as spliced: flatten_if(dots, is_spliced) } rlang/man/lang.Rd0000644000176200001440000000123613241305652013343 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{lang} \alias{lang} \alias{new_language} \title{Create a call} \usage{ lang(.fn, ..., .ns = NULL) new_language(head, tail = NULL) } \arguments{ \item{.fn}{Function to call. Must be a callable object: a string, symbol, call, or a function.} \item{...}{Arguments to the call either in or out of a list. These dots support \link[=tidy-dots]{tidy dots} features.} \item{.ns}{Namespace with which to prefix \code{.fn}. Must be a string or symbol.} } \description{ This function is soft-deprecated, please use \code{\link[=call2]{call2()}} instead. } \keyword{internal} rlang/man/quasiquotation.Rd0000644000176200001440000001660413241233650015513 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quasiquotation.R \name{quasiquotation} \alias{quasiquotation} \alias{UQ} \alias{UQE} \alias{UQS} \alias{UQ} \alias{UQE} \alias{UQS} \alias{!!} \alias{!!!} \alias{:=} \alias{qq_show} \title{Quasiquotation of an expression} \usage{ UQ(x) UQE(x) UQS(x) "!!"(x) ":="(x, y) qq_show(expr) } \arguments{ \item{x}{An expression to unquote.} \item{y}{An R expression that will be given the argument name supplied to \code{x}.} \item{expr}{An expression to be quasiquoted.} } \description{ Quasiquotation is the mechanism that makes it possible to program flexibly with tidy evaluation grammars like dplyr. It is enabled in all tidyeval quoting functions, the most fundamental of which are \code{\link[=quo]{quo()}} and \code{\link[=expr]{expr()}}. Quasiquotation is the combination of quoting an expression while allowing immediate evaluation (unquoting) of part of that expression. We provide both syntactic operators and functional forms for unquoting. \itemize{ \item The \code{!!} operator unquotes its argument. It gets evaluated immediately in the surrounding context. \item The \code{!!!} operator unquotes and splices its argument. The argument should represents a list or a vector. Each element will be embedded in the surrounding call, i.e. each element is inserted as an argument. If the vector is named, the names are used as argument names. } Use \code{qq_show()} to experiment with quasiquotation or debug the effect of unquoting operators. \code{qq_show()} quotes its input, processes unquoted parts, and prints the result with \code{\link[=expr_print]{expr_print()}}. This expression printer has a clearer output than the base R printer (see the \link[=expr_print]{documentation topic}). } \section{Unquoting names}{ When a function takes multiple named arguments (e.g. \code{dplyr::mutate()}), it is difficult to supply a variable as name. Since the LHS of \code{=} is quoted, giving the name of a variable results in the argument having the name of the variable rather than the name stored in that variable. This problem is right up the alley for the unquoting operator \code{!!}. If you were able to unquote the variable when supplying the name, the argument would be named after the content of that variable. Unfortunately R is very strict about the kind of expressions supported on the LHS of \code{=}. This is why we have made the more flexible \code{:=} operator an alias of \code{=}. You can use it to supply names, e.g. \code{a := b} is equivalent to \code{a = b}. Since its syntax is more flexible you can unquote on the LHS:\preformatted{name <- "Jane" dots_list(!!name := 1 + 2) exprs(!!name := 1 + 2) quos(!!name := 1 + 2) } Like \code{=}, the \code{:=} operator expects strings or symbols on its LHS. } \section{Theory}{ Formally, \code{quo()} and \code{expr()} are quasiquote functions, \code{!!} is the unquote operator, and \code{!!!} is the unquote-splice operator. These terms have a rich history in Lisp languages, and live on in modern languages like \href{https://docs.julialang.org/en/stable/manual/metaprogramming/}{Julia} and \href{https://docs.racket-lang.org/reference/quasiquote.html}{Racket}. } \section{Life cycle}{ \itemize{ \item Calling \code{UQ()} and \code{UQS()} with the rlang namespace qualifier is soft-deprecated as of rlang 0.2.0. Just use the unqualified forms instead. Supporting namespace qualifiers complicates the implementation of unquotation and is misleading as to the nature of unquoting operators (these are syntactic operators that operates at quotation-time rather than function calls at evaluation-time). \item \code{UQ()} and \code{UQS()} were soft-deprecated in rlang 0.2.0 in order to make the syntax of quasiquotation more consistent. The prefix forms are now \code{`!!`()} and \code{`!!!`()} which is consistent with other R operators (e.g. \code{`+`(a, b)} is the prefix form of \code{a + b}). Note that the prefix forms are not as relevant as before because \code{!!} now has the right operator precedence, i.e. the same as unary \code{-} or \code{+}. It is thus safe to mingle it with other operators, e.g. \code{!!a + !!b} does the right thing. In addition the parser now strips one level of parentheses around unquoted expressions. This way \code{(!!"foo")(...)} expands to \code{foo(...)}. These changes make the prefix forms less useful. Finally, the named functional forms \code{UQ()} and \code{UQS()} were misleading because they suggested that existing knowledge about functions is applicable to quasiquotation. This was reinforced by the visible definitions of these functions exported by rlang and by the tidy eval parser interpreting \code{rlang::UQ()} as \code{!!}. In reality unquoting is \emph{not} a function call, it is a syntactic operation. The operator form makes it clearer that unquoting is special. \item \code{UQE()} was deprecated in rlang 0.2.0 in order to make the is deprecated in order to simplify the quasiquotation syntax. You can replace its use by a combination of \code{!!} and \code{get_expr()}. E.g. \code{!! get_expr(x)} is equivalent to \code{UQE(x)}. \item The use of \code{:=} as alias of \code{~} is defunct as of rlang 0.2.0. It caused surprising results when invoked in wrong places. For instance in the expression \code{dots_list(name := 1)} this operator was interpreted as a synonym to \code{=} that supports quasiquotation, but not in \code{dots_list(list(name := 1))}. Since \code{:=} was an alias for \code{~} the inner list would contain formula-like object. This kind of mistakes now trigger an error. } } \examples{ # Quasiquotation functions quote expressions like base::quote() quote(how_many(this)) expr(how_many(this)) quo(how_many(this)) # In addition, they support unquoting. Let's store symbols # (i.e. object names) in variables: this <- sym("apples") that <- sym("oranges") # With unquotation you can insert the contents of these variables # inside the quoted expression: expr(how_many(!!this)) expr(how_many(!!that)) # You can also insert values: expr(how_many(!!(1 + 2))) quo(how_many(!!(1 + 2))) # Note that when you unquote complex objects into an expression, # the base R printer may be a bit misleading. For anstance compare # the output of `expr()` and `quo()` (which uses a custom printer) # when we unquote an integer vector: expr(how_many(!!(1:10))) quo(how_many(!!(1:10))) # This is why it's often useful to use qq_show() to examine the # result of unquotation operators. It uses the same printer as # quosures but does not return anything: qq_show(how_many(!!(1:10))) # Use `!!!` to add multiple arguments to a function. Its argument # should evaluate to a list or vector: args <- list(1:3, na.rm = TRUE) quo(mean(!!!args)) # You can combine the two var <- quote(xyz) extra_args <- list(trim = 0.9, na.rm = TRUE) quo(mean(!!var , !!!extra_args)) # The plural versions have support for the `:=` operator. # Like `=`, `:=` creates named arguments: quos(mouse1 := bernard, mouse2 = bianca) # The `:=` is mainly useful to unquote names. Unlike `=` it # supports `!!` on its LHS: var <- "unquote me!" quos(!!var := bernard, mouse2 = bianca) # All these features apply to dots captured by enquos(): fn <- function(...) enquos(...) fn(!!! args, !!var := penny) # Unquoting is especially useful for building an expression by # expanding around a variable part (the unquoted part): quo1 <- quo(toupper(foo)) quo1 quo2 <- quo(paste(!!quo1, bar)) quo2 quo3 <- quo(list(!!quo2, !!!syms(letters[1:5]))) quo3 } rlang/man/is_reference.Rd0000644000176200001440000000251713241233650015054 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{is_reference} \alias{is_reference} \title{Is an object referencing another?} \usage{ is_reference(x, y) } \arguments{ \item{x, y}{R objects.} } \description{ There are typically two situations where two symbols may refer to the same object. \itemize{ \item R objects usually have copy-on-write semantics. This is an optimisation that ensures that objects are only copied if needed. When you copy a vector, no memory is actually copied until you modify either the original object or the copy is modified. Note that the copy-on-write optimisation is an implementation detail that is not guaranteed by the specification of the R language. \item Assigning an \link[=is_copyable]{uncopyable} object (like an environment) creates a reference. These objects are never copied even if you modify one of the references. } } \examples{ # Reassigning an uncopyable object such as an environment creates a # reference: env <- env() ref <- env is_reference(ref, env) # Due to copy-on-write optimisation, a copied vector can # temporarily reference the original vector: vec <- 1:10 copy <- vec is_reference(copy, vec) # Once you modify on of them, the copy is triggered in the # background and the objects cease to reference each other: vec[[1]] <- 100 is_reference(copy, vec) } rlang/man/as_bytes.Rd0000644000176200001440000000065413241233650014234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-bytes.R \name{as_bytes} \alias{as_bytes} \title{Coerce to a raw vector} \usage{ as_bytes(x) } \arguments{ \item{x}{A string.} } \value{ A raw vector of bytes. } \description{ This currently only works with strings, and returns its hexadecimal representation. } \section{Life cycle}{ Raw vector functions are experimental. } \keyword{internal} rlang/man/lang_modify.Rd0000644000176200001440000000221713241305652014712 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{lang_modify} \alias{lang_modify} \alias{lang_standardise} \alias{lang_fn} \alias{lang_name} \alias{lang_args} \alias{lang_args_names} \title{Manipulate or access a call} \usage{ lang_modify(.lang, ..., .standardise = FALSE) lang_standardise(lang) lang_fn(lang) lang_name(lang) lang_args(lang) lang_args_names(lang) } \arguments{ \item{...}{Named or unnamed expressions (constants, names or calls) used to modify the call. Use \code{NULL} to remove arguments. These dots support \link[=tidy-dots]{tidy dots} features.} \item{.standardise}{If \code{TRUE}, the call is standardised beforehand to match existing unnamed arguments to their argument names. This prevents new named arguments from accidentally replacing original unnamed arguments.} \item{lang, .lang}{The \code{call} or \code{.call} argument of the renamed functions.} } \description{ These functions are soft-deprecated, please use \code{\link[=call_modify]{call_modify()}}, \code{\link[=call_standardise]{call_standardise()}}, or \code{\link[=call_fn]{call_fn()}} instead. } \keyword{internal} rlang/man/dots_definitions.Rd0000644000176200001440000000231513241304434015762 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dots.R \name{dots_definitions} \alias{dots_definitions} \title{Capture definition objects} \usage{ dots_definitions(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all")) } \arguments{ \item{...}{For \code{enexprs()}, \code{ensyms()} and \code{enquos()}, names of arguments to capture without evaluation (including \code{...}). For \code{exprs()} and \code{quos()}, the expressions to capture unevaluated (including expressions contained in \code{...}).} \item{.named}{Whether to ensure all dots are named. Unnamed elements are processed with \code{\link[=expr_text]{expr_text()}} to figure out a default name. If an integer, it is passed to the \code{width} argument of \code{expr_text()}, if \code{TRUE}, the default width is used. See \code{\link[=exprs_auto_name]{exprs_auto_name()}}.} \item{.ignore_empty}{Whether to ignore empty arguments. Can be one of \code{"trailing"}, \code{"none"}, \code{"all"}. If \code{"trailing"}, only the last argument is ignored if it is empty.} } \description{ Capture definition objects } \section{Life cycle}{ \code{dots_definitions()} is experimental. Expect API changes. } \keyword{internal} rlang/man/vector-coercion.Rd0000644000176200001440000001101513241233650015515 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-coerce.R \name{vector-coercion} \alias{vector-coercion} \alias{as_logical} \alias{as_integer} \alias{as_double} \alias{as_complex} \alias{as_character} \alias{as_string} \alias{as_list} \title{Coerce an object to a base type} \usage{ as_logical(x) as_integer(x) as_double(x) as_complex(x) as_character(x, encoding = NULL) as_string(x, encoding = NULL) as_list(x) } \arguments{ \item{x}{An object to coerce to a base type.} \item{encoding}{If non-null, passed to \code{\link[=set_chr_encoding]{set_chr_encoding()}} to add an encoding mark. This is only declarative, no encoding conversion is performed.} } \description{ These are equivalent to the base functions (e.g. \code{\link[=as.logical]{as.logical()}}, \code{\link[=as.list]{as.list()}}, etc), but perform coercion rather than conversion. This means they are not generic and will not call S3 conversion methods. They only attempt to coerce the base type of their input. In addition, they have stricter implicit coercion rules and will never attempt any kind of parsing. E.g. they will not try to figure out if a character vector represents integers or booleans. Finally, they have treat attributes consistently, unlike the base R functions: all attributes except names are removed. } \section{Coercion to logical and numeric atomic vectors}{ \itemize{ \item To logical vectors: Integer and integerish double vectors. See \code{\link[=is_integerish]{is_integerish()}}. \item To integer vectors: Logical and integerish double vectors. \item To double vectors: Logical and integer vectors. \item To complex vectors: Logical, integer and double vectors. } } \section{Coercion to character vectors}{ \code{as_character()} and \code{as_string()} have an optional \code{encoding} argument to specify the encoding. R uses this information for internal handling of strings and character vectors. Note that this is only declarative, no encoding conversion is attempted. See \code{\link[=as_utf8_character]{as_utf8_character()}} and \code{\link[=as_native_character]{as_native_character()}} for coercing to a character vector and attempt encoding conversion. See also \code{\link[=set_chr_encoding]{set_chr_encoding()}} and \code{\link[=mut_utf8_locale]{mut_utf8_locale()}} for information about encodings and locales in R, and \code{\link[=string]{string()}} and \code{\link[=chr]{chr()}} for other ways of creating strings and character vectors. Note that only \code{as_string()} can coerce symbols to a scalar character vector. This makes the code more explicit and adds an extra type check. } \section{Coercion to lists}{ \code{as_list()} only coerces vector and dictionary types (environments are an example of dictionary type). Unlike \code{\link[base:as.list]{base::as.list()}}, \code{as_list()} removes all attributes except names. } \section{Effects of removing attributes}{ A technical side-effect of removing the attributes of the input is that the underlying objects has to be copied. This has no performance implications in the case of lists because this is a shallow copy: only the list structure is copied, not the contents (see \code{\link[=duplicate]{duplicate()}}). However, be aware that atomic vectors containing large amounts of data will have to be copied. In general, any attribute modification creates a copy, which is why it is better to avoid using attributes with heavy atomic vectors. Uncopyable objects like environments and symbols are an exception to this rule: in this case, attributes modification happens in place and has side-effects. } \examples{ # Coercing atomic vectors removes attributes with both base R and rlang: x <- structure(TRUE, class = "foo", bar = "baz") as.logical(x) # But coercing lists preserves attributes in base R but not rlang: l <- structure(list(TRUE), class = "foo", bar = "baz") as.list(l) as_list(l) # Implicit conversions are performed in base R but not rlang: as.logical(l) \dontrun{ as_logical(l) } # Conversion methods are bypassed, making the result of the # coercion more predictable: as.list.foo <- function(x) "wrong" as.list(l) as_list(l) # The input is never parsed. E.g. character vectors of numbers are # not converted to numeric types: as.integer("33") \dontrun{ as_integer("33") } # With base R tools there is no way to convert an environment to a # list without either triggering method dispatch, or changing the # original environment. as_list() makes it easy: x <- structure(as_environment(mtcars[1:2]), class = "foobar") as.list.foobar <- function(x) abort("dont call me") as_list(x) } rlang/man/call_args.Rd0000644000176200001440000000211013241233650014337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{call_args} \alias{call_args} \alias{call_args_names} \title{Extract arguments from a call} \usage{ call_args(call) call_args_names(call) } \arguments{ \item{call}{Can be a call or a quosure that wraps a call.} } \value{ A named list of arguments. } \description{ Extract arguments from a call } \section{Life cycle}{ In rlang 0.2.0, \code{lang_args()} and \code{lang_args_names()} were soft-deprecated and renamed to \code{call_args()} and \code{call_args_names()}. See lifecycle section in \code{\link[=call2]{call2()}} for more about this change. } \examples{ call <- quote(f(a, b)) # Subsetting a call returns the arguments converted to a language # object: call[-1] # On the other hand, call_args() returns a regular list that is # often easier to work with: str(call_args(call)) # When the arguments are unnamed, a vector of empty strings is # supplied (rather than NULL): call_args_names(call) } \seealso{ \code{\link[=fn_fmls]{fn_fmls()}} and \code{\link[=fn_fmls_names]{fn_fmls_names()}} } rlang/man/figures/0000755000176200001440000000000013242736025013600 5ustar liggesusersrlang/man/figures/rlang.png0000644000176200001440000006236413241233650015417 0ustar liggesusersPNG  IHDRxb]e /iCCPICC profileHǝwTTϽwz0z.0. Qf Ml@DEHb!(`HPb0dFJ|yyǽgs{.$O./ 'z8WGбx0Y驾A@$/7z HeOOҬT_lN:K"N3"$F/JPrb[䥟}Qd[Sl1x{#bG\NoX3I[ql2$ 8xtrp/8 pCfq.Knjm͠{r28?.)ɩL^6g,qm"[Z[Z~Q7%" 3R`̊j[~: w!$E}kyhyRm333: }=#vʉe tqX)I)B>== <8Xȉ9yP:8p΍Lg kk Ѐ$t!0V87`ɀ2A. @JPA#h'@8 .: ``a!2D!UH 2 dA>P ECqB**Z:]B=h~L2  5pN:|ó@ QC !H,G6 H9R ]H/r Aw( Q(OTJCm@*QGQ-(j MF+ 6h/*t:].G7Зw7 Xa<1:L1s3bXyeb~19 vGĩp+5qy^ oó|= ?'Htv`Ba3BDxHxE$Չ"XAP44077&9$An0;T2421t.54ld+s;# V]=iY9FgM֚k&=%Ō:nc1gcbcfX.}lGv{c)LŖN퉛w/p+/<j$.$%&㒣OdxTԂԑ4i3|o~C:&S@L u[Uo3C3OfIgwdO|;W-wsz 17jl8c͉̈́3+{%lKWr[ $ llGmnacOkE&EEY׾2⫅;K,KhtiN=e²{^-_V^Oo§s]?TWީrjVQ=w}`嚢zԶiו8>k׍ E  [ly邟~_Y53rW򯎼^{7so}x>|쇊z>yz;lbKGD pHYs!7!73XztIME D IDATxwWuO^kvTmubmLIP[?z 8!BM ` ݲ%[]mvhw5ڕE(}$>=9SOlL&=ZLQ{>6s.!C '%h"iCM&NM{֫d2~pjSSlU $I M@;V?Tu h-drG"Wd2Y>&-[ݚ`Mm;Z}R2z{tc\ %IB VW}ݣj8^8%0d2Gf6?6Nd2){zzbWLۍ' v dYwwt! ?mc٭"L0 vU\W32c;:"5(4M*3i&ʭ$;WT'SKOVN߽"pl\"RQ5e m@Q uם!@lnd2̺?hA?];sQacll,SNQp.B q\MAZZD"~Ǒ.V}J2|z=`!n(nO;>@lS+sR220%hO*hj "4p)@l5 ܔL&D3mA Z! wc$I;+=8ё,tJFQߖzjz*FSS(B*w/}z2l: ?!nuT̋WYLAQDCFb( ͅ=U/@3T,斠mgg'7%LUBV~xM&.k`\5MRNbN]8 oRH ~f237%òܹnCV zzzī0]5;x'*"nmLWRغ<>108YQG4u]r]RB5vUuwDhi * /&Yu*~{խJO~o>)^z{{DB=DUzCu.\Eض$)w|\*zeW{qGo@d6yFK ~ض;OT82LUSu]8QG`"8L&D"! OkPz2_xq#GUKOH d3eE9R\}ueC[x^~A$qP1-ߺ+۹Ǐ;íRUA$ꧽ=L8öv~ d+~[v?UɊY/RJEu]d3::= 1㵚L2mcN,T*ކ:YR,\w9l;o Jt]%ӹ4ZutnGgUT;xY!Ls?+O`r Gs¶y BHrgl<{Q1m.8o]r6߾9}9(rޯ)tvFeSsPd5%cUꞪVsNvrB;{zz~.V6<=pkB3ӫvl:KKKst7\ץuU7%k9J]dR&nUOOsęlܞv'8 r|5NGǮ(ʼ^OO[Bxq] ];w%ZQY9/sXp{Wy捧OLd11Q 5΅;}FX>D `<[bAB >M W_ N !TgE8-m!~ UL&UBT'H$^iN`SE22+ MSOcr=Xqګãi0f?qE=":M2*x6D"a%dӣܪ;xexu=z.㺒TdRѪku݆mTm|c/uo>e;)kDQ\ rh* Ӵ uU/]I0d-a Z5=Nk$WOH&'TtՀtˁ4/lhBxi*,v_Z0`1=Ɩ+x|Q&R9Q~#=VAj2{B"şPE0@=dZgm]{SU$齈ꮭ=o+n9dp -ٲp]` >?%›ŰOV-"ȞL*q:X&,3@Z a_rY:%_K>_ s)O/^[ TB Ͼl_NL>mm(64O ܘL&ӣ(===gsL7YPț13bLDh#F4R/}!<+mgN 8eϼ  ɪD;xKx=qgNqRJBA?V}N~Ά-׮QR:0F`"ݓ&*0===[\!k!}i|BҐno2l! LP&dR]C>6Cu%oy*X40^ ŕk hS{na6c~1K4"GL02Rgペ/74 8bd8xi)x˞m\ iY]KsRajՆ)+H Kb\t_v^fm'-ZRmJ)4:ZcqF!  %#,Lsq.y Xg C?ed,]6 =b|,hsiZ#K=1DzNѣ|=^TLFLSkx vbBPg2>;(ZMS2>Nlg95q;vW} ЏE~eNmΓXYHw);<].rnSV"g,jlP3!_\Wz ziri}K7M;*7)WlBs T2)+uT2Q䂘׮K& uʍ{4`#!J&B(e/Ks]$pԞe! ?_(S* B|VZ["uLR#V+ vߴQcpRT+ }G|s6]W8J*k 22pFpYhgÆ[Eqz }\vC>xS.dlML&Sb^o_ Rrٳֳes7K6˗xA~(M^ۙJٽ8\\)O$D,uk:F ryu=gm\ I6o_ط7}T2['gu}^@O]ｅ>xikϼWwpë]oj"?~{hZ%O xKdŲynC}[>xūTT_KӴĢzPK)$l7UbD=-ӣ-DR\ץP,XMSTg|_?jqXx<̵לK_Jϑ#m%KbE}]{z)-Z[#5l}'Ӳݝox7__ކϧκ WqSPSWrTUw²ݳ7y(O͖(ˈY ӴlVl/BGן38 hYՌgV%T2q ]4w>P:K<{̜5g.~_z)zx۾XqQE;կ29T2AcOh+7qdU*7 >o|޳?ofe/k%,ze !S _ݔJ9:Ƈ>TL E\G+  V%7|0l\S dJo8CCSlG!<>u. ^gů\tM={.>߯ʁCdEJ(v)-R 47G_v9rB`&T.9 ˲Qe [š##57! t"?r5f J ̛XfݺNk/"3>f\}ݢ)JI0h`"fiTͩB :J_ݸR# ek^`lNÏ:Kh ʆD}8.->kq]/ɮ])U^eWniHkQbղ3!?Lq溒HO0裯o`PȊ"(L/˪ xro?dftMe|"jڏx- wuϔe޴i9ϻB)^AKsױjeG eXJ`q=wnLF$ |sιv:7=9{$:A@lTN#?5\B4/Oyӆe\,3U*q?z Kկ[]T*Zqo\dz< 8phxU{ O>]^0L}.Z5T׵Y>|JZp링r8tx3_de_\-߽vik񏼔 Q(T qR_.= _?{_؁J٥sw/+iyI*<9),~~N(?fU SY Yky.q$P)["jmOo8نzկ}}O p5CW22[_ɮǎp-җlg?jd+xRPED|÷O[W7pÍCC\,{jnYq;T`Wk 47άkQ[_m9mA&[<#r}Js|VG<4^ID d|K:]mikb[6_|xdRjX_!q, 2-}h$@z¼a7|XR|>tcw`[BPql۝^jzv>okF<\p)%{Qo.]KO ˴&/͙W<ۏ[H=`yg-B`Y6jU\ /(i ( s/9-S̺/ǑrEJe`ӧ>rHz׽io1<2{j|vsejL)-"@=T#;$V63Jv: y{[F*m}g9򰚛|?oЬ rwL.MSuGFt ]D5wx+85̅Pȇ߯3>㚫!+qx>~;P CWL1Wlmkg$ .[bd,]Oˆ]qz֮YRxzq4^^["GhmX[u)vn? MSfy]OWŬhgζxrhbN5{$hiP*g;^??qMSO(v8oJ-ϣP*ViSTמhJ `ц!%DŐ%P?F(=0ΔK>4-Gb<Ȟ'(+,]_w%۷CJ}WO/x34~G9ˋۓ spj 9/cHt/:J:Ǒ6Gzvhmr5j9ɳžLM]5Sַ}]s7.'* f` =]w玲-:oZ @M޻RX;uѱ SI~HE6T* y_Nj 3 .g_-DLдTիt{ Ǐ5lD4 ֒<֥-JlUcm|; {KӔ9ӣ5DzsE|iJlW0PJY197 &PUExE=Ym+ecSy|tի >6 +kC9;vR<6|:v-J0h 7hTJoވ_ǎ70Ѩzp ,MI6XV6+T\MJ&2q$#t% (ARb[8vO꿹`p9.4E`iu~f(S2 d1CriDUNpwx wDkm6l~Ny.vnuss ,(r_ f)B4ڂF?)ogqiʸM{.k⸂X֮ )X"XҢ~N$$QkDu%)|IA:S9ɑ!].K$TH\[iו57mbuz,&؀xv!o n! 1.*K:U[J9AV5ya T0iH8kJ<8N[M- ,k3ٸ:YA%;C:.rŻS-21Y&12Vd *xCebɥPrIR( tE 8jQk(3![<7yW&0f\^|(^T^{óL?; ":\Ŵ*DղF7I:P1EbZ' ``ܖ:w7AG[+tuYa1!Ht!":lhA:CC%,&G&]®PyN+C )bADӔziݚzl˱ P199וT*hi %(R;p%HK9~|rŞS5H Ma2ɑsk7C}*-+bE+. sE~n$IZtQ-B "`Yd&YH-g-&&]/1u2YHXspX}ԸuFCq5%.SS9c1v<6'O/5Z'۹hT s/KO?O~#(U_3)ekR̓5 jkE6J鄂* {owxxwmg, rq,ei*4qݢC{E+lYmTʋ5^z]PSGTL kdl~_/p Qz& IUUIW3#'NuMWuv:>C4GFY R:V8yi70YQ* w=pvRTapttPt\%\)`Y:D@8L4$hkk.  .=*T1*$Lr \&&rO#. P"d }N>I[Ԡ#b,Jkl(F:Gj%8q+[H?Kpe_[ B(CøQx7wyi13s/՚f>!-zZt|֕0$=㊗ LT@pMSQbq+QQ@k݄,]18vH`6(.D SBt.Í"ן3|3߻)+wcITRy>O/]o{w)F* g7/[O2̭=vm¡0b6U@A"MP `Z߀_2G EhQ>8 ԝ@-(w$\M0|:EQymoΙ?ۛu}G=ES&{q_.WZMd׳<𮷶Pr0*v 4x?>iXS(cǠG6- 0(Z NE q+),TBU5X[TR%.Ϧ O* (UU(+1MA!sMO0waG&j4%}ԂXFkV Q&L|-.QWM`ڸ2"?ލ$ҒP̠taN!Єp9*Z8N !|\Ch삋ފ3ChQ?BYYwjewO[J]s+LTpZI9gDVLļXQʬ.9^8*dKKM'JXtQ$W\#@#u H;bq-Ŝ@|hv,j|Fl W`Pz),8Jp"`i3ES\~ *]|!̧EUU0<6QDm6ws XYE[oe%u#8B(@EQ*7_Ò%ׇZw\AK|Nl7B`ڌS.aZWa&k9:puը7B D1Dd콓Jo=;amm]tbv2ܗ֟/,lٗodE*eHr >Cpl ׯE1RbŒ?@6;| o6BCoh!,7@_v>z|z2"6P(\ъ4+)CG1GqIS,9uVt/,vA2J |L KiP'u :V(&'q&VDmV\);|MLbe'zQc?31N.-,iMlh]a%~:ZsRZH"&r\2џ"Lyw>iP(@T{%5?r~G# ;pjWE>ߤR jZ0]^yMǯO)J#HO|:0Z8ꋢZТq,?}ùHe9OfQ)#~ɮ/ŒAeZ;z#:~%Ԣ9vkq&#s Ta`Aw"u0W߀ӝ3H#%GzǦ>wh}k8%G!oj%Ja@6'Q/`h@A -zY8>xLj1Aav tEҖXI Iًb>Gw3vdW]JtY6yuyںpvQ%f I#t\5kSrhB%dUEw{|&k YJB=kg4.UrǮ Œs/_|<^s0k09^km7EkwҴ XDHs;8Os/i"irFFs:T̤8N,:=2(<_gk)49^\ vܽ\_8iΘQ_Е<:Y"Wi fe0>(0ձ\|Z>ɩ|9㢽ւj;םG_)߯ f:湛p"kV*e['ꧥ-h_ MQʹd3Yږ6"VIoEȧL/hm697E45-Ut%G9GՠmyR`K_RKi ,-g*35[7Һ((gHfG|Ht,R ON?';TUO,uԏ"J=m3|+w p̨Z׹db"w.k5[j[Nh1vTrd[':A_&)#ƪu ` E 5jt,i*8+V/ д~֥Vn:\^g#Gp&n>uob`8NEE17/ZQ7ܵ[+;pKpi:Y*9_$B߱`kw$WiKѺx[!tkaYWIOU?kT F^9G[V.ڶܾwVМ?V;qN8U! R8֗%o"hZI8R(vl\X0Gkgj128Lvb ͭ*6Os9 -1*1]״fJ\ɢ\*9YGfYa)c})\E'R,]$IM9/ϳ^'dJMd ^^6W\ʖ|aZN]8v|fΈ Mnb!:cş u];mu!S3pWl CbNq5iYCR)IEwo]9BCkWi_ٱbyO1e6/&36N[wAZVM5"J#;1ru6>-Q(, i iR2o o?}šwH0>(lo`G;LP9 BTv…*L9km'X3KUGR|simKt1\Ch[I{Q9!$m~]ް2-ߴ dOci{#OͨBKgfNO(59GGG|8fQDΕ-i[$_)j IK(?4I,S*8 |Lf䌍Q?Qvyy/8?k34W0:yFB/o #Wdp%{KrYVCS-tYae(:.A!ZVXn_2KNJBd"lҽm)Gz Q$/{qVB +7tc Z;DKWݫ[ٲ9^D8}.eKl8c(Z5aW&%1c/P,/.UDžXHp~0/ y}g36VF wׯelȞtH 22fw{RTѽwp<β|p2n 5GPqd͖4[Kv|G{"fY~{? 밈&}"Au]{}>LdYaZZhnۇj% 4n׮f2ɑAzlbL;OLr :/٢['VgeWxhLJc&:[|hM:cq}I~n;icc%V't6 B)m&+ gGik )t$34- Y[ǎs tEav&2.rx$NrK/"U(PRzK)˴hoSŭrkT&3]>|~W/AKŴy_p3jX(LRMU B_r~zmRX " $1CS$Rybq|&hf]E}`x\!ș E[G&U\ac\;~5@0>S*Ҿ801 {uUK6ˣiZ;(vMx`@S%KCNNp 32T_J*Dh~KZ=WxTY2g>aVYW*.Ʀ$~I]J\:E6=Dx%4hy]]#,K6}sGаYk;ؼd4W-&R%Rq I)69TrZ{{]M+]^zM/༳r-1%MDZ29HӾj %e -m]FZ%@$3j۟z,9;?!Jn^6tk!L<%`3zZJպ,?I[BN̾9s?ΙxZۢx=V:YPG'+睻ܿgAx߬KbE_`_}ORs6㳂Zi(V#\~zN9Nǒr,=196Mo:6* !^a'퇨B x&7ȳK3p-Hg\ivNH\ZD&Q)sN4\ãU{7s# 1kK|SMKtJ82$Oo俿4fT!b))M0⭗ubm 4IjT"O>5E+w)XLx<-i=Vd\d JIсvS M#mʴ>y.IDAT6(?u4o9%macce*eOHN]TJxݬZ}ۓC3<7\'s'g ҶcY$82Yf$(V}j6e}(=}9:Ғ$*bY&Οa*9uU;TFaXRBE(DZ1SfqjgbqCI84b6BYhK0TXaLi vҸF EP Y5ٸ:uyEZ-buLQ۠M](]$lT aP/ E4;.U= mN]YI\ daSW<~8shL*v$ל4mqaXjq Ŧ=֭.r{Xn1m y yv o\e*l3`hXd'-tă #üE&R56'*0WΡH( c,HYQޞPќwV/c|mz a`LA,\<3dj^ǟ K{\ Y&6<  V(Ǧ_c\GJtZi7b[:ZLÍæJeҚ0>Zd6WHbK[feLN8"qt߸=GBni2#Yy\Ͽ5Yhq"tXTMvNB2SBۂi%qĵvjh6fs%^f/8&#!{xxwSV\tGuB%dO1]qod;w0vJp?Ų>.-.R` B=6 IbV[,bi02 UMuБI5TJ&q0=ZY:-xߧ%۟mdR՝=%RiXV4}*s@;5@ :I4 yϕ9weڬXFZ.s ;bnLD~ƹ[5r&uLXp%p<>R9wc@;O"u%CszN:ߣUD BhҶ𗷌sf5J[D wo=¡ m͓tgM*1T"n$7^,ZD`~#ɀMgg)WO=[&2(dR$q-͡s eP,Tg DH- [l\R(E(!j5PqBʊ<ۑͅdy۟NcPbRiYR)pݤg}y=Ϸ>䗉(`i{L ;z+ c,s5n~Jib%LO޲w9R)a3:֏F Pv%Yfv>b20 ;ED!ah<[P ߹ۯ^i[a8P[dR6?2?9f0Z}+o &Hkl6g$>6;liqÅYN#fe/IsZ(fb6 ҙ}h H|W|kTA-iM,Nr o+3 tk$Hؾ7bYG6UoMFkdqDYpw1 pG\pjR9fhaeLLCS%HۢBWodlʟ߼5K. uM0 +\i1hbD3gsU~)**B"mx[okmzĔc'V,\5?9:|m/TDAPXbO+q ½]JіJhᢚ"< {ti,|>o7ͿĐr ˧58̇ $JMi˚#H0dSͻ*Lk.9NXՇX-x[7OsglcMbZ$O yE?+<'@1W7'LsҲQx(WcXT *7_HS&[|+*´hϥN '#WNj:PQM OIQzrVM[2hk/_0]g+i'c)D[O_^3y 72}OoMʪOTBL@8Ú?ђ1hr(1 V}Oٶ_ B A k{-$ﺴɢ&cNZ+ ruYVA:Nq2/`xv0 8NG\znkzCzm~+ڨ*03Rcf^ӑMS,P7G{&eDh<1>Y8ͦ q /h,G?*iGn:o8f7-Ew6pi&~Q_DECeK`cCm_ѸU4J-?1M:cl}͟ynZ RDk ń~kE].uicP#Q NY1)W5CSG&cXC1̓lFbZCCTڤehZH͑\4R$fq&F`鳾4nZ.pھ!(&V&s\atv؜sZ @x[Ny.;š'gNCƅb>Hp\>RedFiҮDR!k=D~JYBrǣ,3MOu5}Ye\5Pr1 >Ak# ;ID'ĶBjH B{^qßEpݐ GƋ D=as98 ]$ɦ zPGפXcbhI%qmhnV}4MG.yE]%Rs!~4}oh);bâXVKCsTI֓d`YҥX[/HېMUbfZeH؛6L) el",r6YA*cj#0X'dMMJiYXKU2ij[+2o;A=b|b3ѢPH0ı5#,IP<3tuQ"0 U Ɇ-Оl}>ͼ $,ДΖ+:Fm)R&=6"2-n}$~. m&arLlN $G} /H <Р=w/WWUx/pJ3"&I${\aϜT+J3"ܹf4oxA)z eDQpS1zZ-I3j5*`dNסg*ܵe?$&H?; G9n4?6W_ Z Q4*BN^R>O%*=梳gJhuQ]B80.ٲ[wHsbWHԘfU!0 %7Hp>(L<;9־:@QMhO#/cN.ji,pgA=zMF&oۨ*&*W6$3o~=8}ϲh #I; "{[r鲇$jTTFQsW?и+M{~%>,7њzHRmsxr#H=)X"@Z7[M!j}4^h K&Z \|hm*SP׿QbTk8e'ta6MkƦC(K6 1U.r#mǛ~yZ zwsyS&Yv':A5}lG6| n /;Z$96qU`ϯhz8)GyE&_U68BcO,~F{B" mPſrZo{+% x!> s/%kho|/j ixǏ6'ZEyJJCMxko}ў~ZIM[m=/*k=IENDB`rlang/man/env_bind.Rd0000644000176200001440000000773713241305652014222 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_bind} \alias{env_bind} \title{Bind symbols to objects in an environment} \usage{ env_bind(.env, ...) } \arguments{ \item{.env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}. This argument is passed to \code{\link[=get_env]{get_env()}}.} \item{...}{Pairs of names and expressions, values or functions. These dots support \link[=tidy-dots]{tidy dots} features.} } \value{ The input object \code{.env}, with its associated environment modified in place, invisibly. } \description{ These functions create bindings in an environment. The bindings are supplied through \code{...} as pairs of names and values or expressions. \code{env_bind()} is equivalent to evaluating a \code{<-} expression within the given environment. This function should take care of the majority of use cases but the other variants can be useful for specific problems. \itemize{ \item \code{env_bind()} takes named \emph{values} which are bound in \code{.env}. \code{env_bind()} is equivalent to \code{\link[base:assign]{base::assign()}}. \item \code{env_bind_fns()} takes named \emph{functions} and creates active bindings in \code{.env}. This is equivalent to \code{\link[base:makeActiveBinding]{base::makeActiveBinding()}}. An active binding executes a function each time it is evaluated. \code{env_bind_fns()} takes dots with \link[=dots_splice]{implicit splicing}, so that you can supply both named functions and named lists of functions. If these functions are \link[=is_closure]{closures} they are lexically scoped in the environment that they bundle. These functions can thus refer to symbols from this enclosure that are not actually in scope in the dynamic environment where the active bindings are invoked. This allows creative solutions to difficult problems (see the implementations of \code{dplyr::do()} methods for an example). \item \code{env_bind_exprs()} takes named \emph{expressions}. This is equivalent to \code{\link[base:delayedAssign]{base::delayedAssign()}}. The arguments are captured with \code{\link[=exprs]{exprs()}} (and thus support call-splicing and unquoting) and assigned to symbols in \code{.env}. These expressions are not evaluated immediately but lazily. Once a symbol is evaluated, the corresponding expression is evaluated in turn and its value is bound to the symbol (the expressions are thus evaluated only once, if at all). } } \section{Side effects}{ Since environments have reference semantics (see relevant section in \code{\link[=env]{env()}} documentation), modifying the bindings of an environment produces effects in all other references to that environment. In other words, \code{env_bind()} and its variants have side effects. As they are called primarily for their side effects, these functions follow the convention of returning their input invisibly. } \examples{ # env_bind() is a programmatic way of assigning values to symbols # with `<-`. We can add bindings in the current environment: env_bind(get_env(), foo = "bar") foo # Or modify those bindings: bar <- "bar" env_bind(get_env(), bar = "BAR") bar # It is most useful to change other environments: my_env <- env() env_bind(my_env, foo = "foo") my_env$foo # A useful feature is to splice lists of named values: vals <- list(a = 10, b = 20) env_bind(my_env, !!! vals, c = 30) my_env$b my_env$c # You can also unquote a variable referring to a symbol or a string # as binding name: var <- "baz" env_bind(my_env, !!var := "BAZ") my_env$baz # env_bind() and its variants are generic over formulas, quosures # and closures. To illustrate this, let's create a closure function # referring to undefined bindings: fn <- function() list(a, b) fn <- set_env(fn, child_env("base")) # This would fail if run since `a` etc are not defined in the # enclosure of fn() (a child of the base environment): # fn() # Let's define those symbols: env_bind(fn, a = "a", b = "b") # fn() now sees the objects: fn() } rlang/man/env_bury.Rd0000644000176200001440000000263313241305652014255 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_bury} \alias{env_bury} \title{Mask bindings by defining symbols deeper in a scope} \usage{ env_bury(.env, ...) } \arguments{ \item{.env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}. This argument is passed to \code{\link[=get_env]{get_env()}}.} \item{...}{Pairs of names and expressions, values or functions. These dots support \link[=tidy-dots]{tidy dots} features.} } \value{ A copy of \code{.env} enclosing the new environment containing bindings to \code{...} arguments. } \description{ \code{env_bury()} is like \code{\link[=env_bind]{env_bind()}} but it creates the bindings in a new child environment. This makes sure the new bindings have precedence over old ones, without altering existing environments. Unlike \code{env_bind()}, this function does not have side effects and returns a new environment (or object wrapping that environment). } \examples{ orig_env <- env(a = 10) fn <- set_env(function() a, orig_env) # fn() currently sees `a` as the value `10`: fn() # env_bury() will bury the current scope of fn() behind a new # environment: fn <- env_bury(fn, a = 1000) fn() # Even though the symbol `a` is still defined deeper in the scope: orig_env$a } \seealso{ \code{\link[=env_bind]{env_bind()}}, \code{\link[=env_unbind]{env_unbind()}} } rlang/man/is_env.Rd0000644000176200001440000000053413241233650013703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{is_env} \alias{is_env} \alias{is_bare_env} \title{Is object an environment?} \usage{ is_env(x) is_bare_env(x) } \arguments{ \item{x}{object to test} } \description{ \code{is_bare_env()} tests whether \code{x} is an environment without a s3 or s4 class. } rlang/man/modify.Rd0000644000176200001440000000156413241305652013715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-utils.R \name{modify} \alias{modify} \title{Modify a vector} \usage{ modify(.x, ...) } \arguments{ \item{.x}{A vector to modify.} \item{...}{List of elements to merge into \code{.x}. Named elements already existing in \code{.x} are used as replacements. Elements that have new or no names are inserted at the end. These dots support \link[=tidy-dots]{tidy dots} features.} } \value{ A modified vector upcasted to a list. } \description{ This function merges a list of arguments into a vector. It always returns a list. } \section{Life cycle}{ \code{modify()} is experimental, expect API changes. We are still figuring out what vector tools belong in rlang. } \examples{ modify(c(1, b = 2, 3), 4, b = "foo") x <- list(a = 1, b = 2) y <- list(b = 3, c = 4) modify(x, splice(y)) } \keyword{internal} rlang/man/empty_env.Rd0000644000176200001440000000071513241233650014427 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{empty_env} \alias{empty_env} \title{Get the empty environment} \usage{ empty_env() } \description{ The empty environment is the only one that does not have a parent. It is always used as the tail of a scope chain such as the search path (see \code{\link[=scoped_names]{scoped_names()}}). } \examples{ # Create environments with nothing in scope: child_env(empty_env()) } rlang/man/new_call.Rd0000644000176200001440000000074313241233650014206 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/node.R \name{new_call} \alias{new_call} \title{Create a new call from components} \usage{ new_call(car, cdr = NULL) } \arguments{ \item{car}{The head of the call. It should be a \link[=is_callable]{callable} object: a symbol, call, or literal function.} \item{cdr}{The tail of the call, i.e. a \link[=node]{node list} of arguments.} } \description{ Create a new call from components } \keyword{internal} rlang/man/f_text.Rd0000644000176200001440000000132113241233650013704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formula.R \name{f_text} \alias{f_text} \alias{f_name} \alias{f_label} \title{Turn RHS of formula into a string or label} \usage{ f_text(x, width = 60L, nlines = Inf) f_name(x) f_label(x) } \arguments{ \item{x}{A formula.} \item{width}{Width of each line.} \item{nlines}{Maximum number of lines to extract.} } \description{ Equivalent of \code{\link[=expr_text]{expr_text()}} and \code{\link[=expr_label]{expr_label()}} for formulas. } \examples{ f <- ~ a + b + bc f_text(f) f_label(f) # Names a quoted with `` f_label(~ x) # Strings are encoded f_label(~ "a\\nb") # Long expressions are collapsed f_label(~ foo({ 1 + 2 print(x) })) } rlang/man/as_quosure.Rd0000644000176200001440000000304313241233650014604 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quo.R \name{as_quosure} \alias{as_quosure} \alias{new_quosure} \title{Coerce object to quosure} \usage{ as_quosure(x, env = caller_env()) new_quosure(expr, env = caller_env()) } \arguments{ \item{x}{An object to convert. Either an \link[=is_expression]{expression} or a formula.} \item{env}{The original context of the context expression.} \item{expr}{The expression wrapped by the quosure.} } \description{ While \code{new_quosure()} wraps any R object (including expressions, formulas, or other quosures) into a quosure, \code{as_quosure()} converts formulas and quosures and does not double-wrap. } \section{Life cycle}{ \itemize{ \item Like the rest of the rlang package, \code{new_quosure()} and \code{as_quosure()} are maturing. \item \code{as_quosureish()} is deprecated as of rlang 0.2.0. This function assumes that quosures are formulas which is currently true but might not be in the future. } } \examples{ # as_quosure() converts expressions or any R object to a validly # scoped quosure: as_quosure(quote(expr), base_env()) as_quosure(10L, base_env()) # Sometimes you get unscoped formulas because of quotation: f <- ~~expr inner_f <- f_rhs(f) str(inner_f) # In that case testing for a scoped formula returns FALSE: is_formula(inner_f, scoped = TRUE) # With as_quosure() you ensure that this kind of unscoped formulas # will be granted a default environment: as_quosure(inner_f, base_env()) } \seealso{ \code{\link[=quo]{quo()}}, \code{\link[=is_quosure]{is_quosure()}} } rlang/man/return_from.Rd0000644000176200001440000000400213241233650014754 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{return_from} \alias{return_from} \alias{return_to} \title{Jump to or from a frame} \usage{ return_from(frame, value = NULL) return_to(frame, value = NULL) } \arguments{ \item{frame}{An environment, a frame object, or any object with an \code{\link[=get_env]{get_env()}} method. The environment should be an evaluation environment currently on the stack.} \item{value}{The return value.} } \description{ While \code{\link[base:return]{base::return()}} can only return from the current local frame, these two functions will return from any frame on the current evaluation stack, between the global and the currently active context. They provide a way of performing arbitrary non-local jumps out of the function currently under evaluation. } \details{ \code{return_from()} will jump out of \code{frame}. \code{return_to()} is a bit trickier. It will jump out of the frame located just before \code{frame} in the evaluation stack, so that control flow ends up in \code{frame}, at the location where the previous frame was called from. These functions should only be used rarely. These sort of non-local gotos can be hard to reason about in casual code, though they can sometimes be useful. Also, consider to use the condition system to perform non-local jumps. } \section{Life cycle}{ The support for \code{frame} object is experimental. The stack and frame objects are likely to be moved from rlang to another package. Please pass simple environments to \code{return_from()} and \code{return_to()}. } \examples{ # Passing fn() evaluation frame to g(): fn <- function() { val <- g(get_env()) cat("g returned:", val, "\\n") "normal return" } g <- function(env) h(env) # Here we return from fn() with a new return value: h <- function(env) return_from(env, "early return") fn() # Here we return to fn(). The call stack unwinds until the last frame # called by fn(), which is g() in that case. h <- function(env) return_to(env, "early return") fn() } rlang/man/missing_arg.Rd0000644000176200001440000000753513241233650014732 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/arg.R \name{missing_arg} \alias{missing_arg} \alias{is_missing} \alias{maybe_missing} \title{Generate or handle a missing argument} \usage{ missing_arg() is_missing(x) maybe_missing(x) } \arguments{ \item{x}{An object that might be the missing argument.} } \description{ These functions help using the missing argument as a regular R object. \itemize{ \item \code{missing_arg()} generates a missing argument. \item \code{is_missing()} is like \code{\link[base:missing]{base::missing()}} but also supports testing for missing arguments contained in other objects like lists. \item \code{maybe_missing()} is useful to pass down an input that might be missing to another function. It avoids triggering an "argument is missing" error. } } \section{Other ways to reify the missing argument}{ \itemize{ \item \code{base::quote(expr = )} is the canonical way to create a missing argument object. \item \code{expr()} called without argument creates a missing argument. \item \code{quo()} called without argument creates an empty quosure, i.e. a quosure containing the missing argument object. } } \section{Fragility of the missing argument object}{ The missing argument is an object that triggers an error if and only if it is the result of evaluating a symbol. No error is produced when a function call evaluates to the missing argument object. This means that expressions like \code{x[[1]] <- missing_arg()} are perfectly safe. Likewise, \code{x[[1]]} is safe even if the result is the missing object. However, as soon as the missing argument is passed down between functions through an argument, you're at risk of triggering a missing error. This is because arguments are passed through symbols. To work around this, \code{is_missing()} and \code{maybe_missing(x)} use a bit of magic to determine if the input is the missing argument without triggering a missing error. \code{maybe_missing()} is particularly useful for prototyping meta-programming algorithm in R. The missing argument is a likely input when computing on the language because it is a standard object in formals lists. While C functions are always allowed to return the missing argument and pass it to other C functions, this is not the case on the R side. If you're implementing your meta-programming algorithm in R, use \code{maybe_missing()} when an input might be the missing argument object. [[1]: R:[1 [[1]: R:[1 } \section{Life cycle}{ \itemize{ \item \code{missing_arg()} and \code{is_missing()} are stable. \item Like the rest of rlang, \code{maybe_missing()} is maturing. } } \examples{ # The missing argument usually arises inside a function when the # user omits an argument that does not have a default: fn <- function(x) is_missing(x) fn() # Creating a missing argument can also be useful to generate calls args <- list(1, missing_arg(), 3, missing_arg()) quo(fn(!!! args)) # Other ways to create that object include: quote(expr = ) expr() # It is perfectly valid to generate and assign the missing # argument in a list. x <- missing_arg() l <- list(missing_arg()) # Just don't evaluate a symbol that contains the empty argument. # Evaluating the object `x` that we created above would trigger an # error. # x # Not run # On the other hand accessing a missing argument contained in a # list does not trigger an error because subsetting is a function # call: l[[1]] is.null(l[[1]]) # In case you really need to access a symbol that might contain the # empty argument object, use maybe_missing(): maybe_missing(x) is.null(maybe_missing(x)) is_missing(maybe_missing(x)) # Note that base::missing() only works on symbols and does not # support complex expressions. For this reason the following lines # would throw an error: #> missing(missing_arg()) #> missing(l[[1]]) # while is_missing() will work as expected: is_missing(missing_arg()) is_missing(l[[1]]) } rlang/man/as_environment.Rd0000644000176200001440000000307713241233650015454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{as_environment} \alias{as_environment} \title{Coerce to an environment} \usage{ as_environment(x, parent = NULL) } \arguments{ \item{x}{An object to coerce.} \item{parent}{A parent environment, \code{\link[=empty_env]{empty_env()}} by default. This argument is only used when \code{x} is data actually coerced to an environment (as opposed to data representing an environment, like \code{NULL} representing the empty environment).} } \description{ \code{as_environment()} coerces named vectors (including lists) to an environment. It first checks that \code{x} is a dictionary (see \code{\link[=is_dictionaryish]{is_dictionaryish()}}). If supplied an unnamed string, it returns the corresponding package environment (see \code{\link[=pkg_env]{pkg_env()}}). } \details{ If \code{x} is an environment and \code{parent} is not \code{NULL}, the environment is duplicated before being set a new parent. The return value is therefore a different environment than \code{x}. } \section{Life cycle}{ \code{as_env()} was soft-deprecated and renamed to \code{as_environment()} in rlang 0.2.0. This is for consistency as type predicates should not be abbreviated. } \examples{ # Coerce a named vector to an environment: env <- as_environment(mtcars) # By default it gets the empty environment as parent: identical(env_parent(env), empty_env()) # With strings it is a handy shortcut for pkg_env(): as_environment("base") as_environment("rlang") # With NULL it returns the empty environment: as_environment(NULL) } rlang/man/sym.Rd0000644000176200001440000000146113241233650013230 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sym.R \name{sym} \alias{sym} \alias{syms} \title{Create a symbol or list of symbols} \usage{ sym(x) syms(x) } \arguments{ \item{x}{A string or list of strings.} } \value{ A symbol for \code{sym()} and a list of symbols for \code{syms()}. } \description{ These functions take strings as input and turn them into symbols. Contrarily to \code{as.name()}, they convert the strings to the native encoding beforehand. This is necessary because symbols remove silently the encoding mark of strings (see \code{\link[=set_str_encoding]{set_str_encoding()}}). } \examples{ # The empty string returns the missing argument: sym("") # This way sym() and as_string() are inverse of each other: as_string(missing_arg()) sym(as_string(missing_arg())) } rlang/man/is_call.Rd0000644000176200001440000000476213241233650014035 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{is_call} \alias{is_call} \title{Is object a call?} \usage{ is_call(x, name = NULL, n = NULL, ns = NULL) } \arguments{ \item{x}{An object to test. If a formula, the right-hand side is extracted.} \item{name}{An optional name that the call should match. It is passed to \code{\link[=sym]{sym()}} before matching. This argument is vectorised and you can supply a vector of names to match. In this case, \code{is_call()} returns \code{TRUE} if at least one name matches.} \item{n}{An optional number of arguments that the call should match.} \item{ns}{The namespace of the call. If \code{NULL}, the namespace doesn't participate in the pattern-matching. If an empty string \code{""} and \code{x} is a namespaced call, \code{is_call()} returns \code{FALSE}. If any other string, \code{is_call()} checks that \code{x} is namespaced within \code{ns}.} } \description{ This function tests if \code{x} is a \link[=call2]{call}. This is a pattern-matching predicate that returns \code{FALSE} if \code{name} and \code{n} are supplied and the call does not match these properties. \code{is_unary_call()} and \code{is_binary_call()} hardcode \code{n} to 1 and 2. } \section{Life cycle}{ \code{is_lang()} has been soft-deprecated and renamed to \code{is_call()} in rlang 0.2.0 and similarly for \code{is_unary_lang()} and \code{is_binary_lang()}. This renaming follows the general switch from "language" to "call" in the rlang type nomenclature. See lifecycle section in \code{\link[=call2]{call2()}}. } \examples{ is_call(quote(foo(bar))) # You can pattern-match the call with additional arguments: is_call(quote(foo(bar)), "foo") is_call(quote(foo(bar)), "bar") is_call(quote(foo(bar)), quote(foo)) # Match the number of arguments with is_call(): is_call(quote(foo(bar)), "foo", 1) is_call(quote(foo(bar)), "foo", 2) # By default, namespaced calls are tested unqualified: ns_expr <- quote(base::list()) is_call(ns_expr, "list") # You can also specify whether the call shouldn't be namespaced by # supplying an empty string: is_call(ns_expr, "list", ns = "") # Or if it should have a namespace: is_call(ns_expr, "list", ns = "utils") is_call(ns_expr, "list", ns = "base") # The name argument is vectorised so you can supply a list of names # to match with: is_call(quote(foo(bar)), c("bar", "baz")) is_call(quote(foo(bar)), c("bar", "foo")) is_call(quote(base::list), c("::", ":::", "$", "@")) } \seealso{ \code{\link[=is_expression]{is_expression()}} } rlang/man/is_namespace.Rd0000644000176200001440000000044613241233650015051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{is_namespace} \alias{is_namespace} \title{Is an object a namespace environment?} \usage{ is_namespace(x) } \arguments{ \item{x}{An object to test.} } \description{ Is an object a namespace environment? } rlang/man/stack_trim.Rd0000644000176200001440000000361613241233650014564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{stack_trim} \alias{stack_trim} \title{Trim top call layers from the evaluation stack} \usage{ stack_trim(stack, n = 1) } \arguments{ \item{stack}{An evaluation stack.} \item{n}{The number of call frames (not eval frames) to trim off the top of the stack. In other words, the number of layers of intervening frames to trim.} } \description{ \code{\link[=ctxt_stack]{ctxt_stack()}} can be tricky to use in real code because all intervening frames are returned with the stack, including those at \code{ctxt_stack()} own call site. \code{stack_trim()} makes it easy to remove layers of intervening calls. } \section{Life cycle}{ These functions are in the questioning stage. We are no longer convinced they belong in rlang as they are mostly for REPL interaction and runtime inspection rather than function development. } \examples{ # Intervening frames appear on the evaluation stack: identity(identity(ctxt_stack())) # stack_trim() will trim the first n layers of calls: stack_trim(identity(identity(ctxt_stack()))) # Note that it also takes care of calls intervening at its own call # site: identity(identity( stack_trim(identity(identity(ctxt_stack()))) )) # It is especially useful when used within a function that needs to # inspect the evaluation stack but should nonetheless be callable # within nested calls without side effects: stack_util <- function() { # n = 2 means that two layers of intervening calls should be # removed: The layer at ctxt_stack()'s call site (including the # stack_trim() call), and the layer at stack_util()'s call. stack <- stack_trim(ctxt_stack(), n = 2) stack } user_fn <- function() { # A user calls your stack utility with intervening frames: identity(identity(stack_util())) } # These intervening frames won't appear in the evaluation stack identity(user_fn()) } \keyword{internal} rlang/man/friendly_type.Rd0000644000176200001440000000126313241233650015275 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{friendly_type} \alias{friendly_type} \title{Format a type for error messages} \usage{ friendly_type(type) } \arguments{ \item{type}{A type as returned by \code{\link[=type_of]{type_of()}} or \code{\link[=lang_type_of]{lang_type_of()}}.} } \value{ A string of the prettified type, qualified with an indefinite article. } \description{ Format a type for error messages } \section{Life cycle}{ \itemize{ \item Like \code{\link[=type_of]{type_of()}}, \code{friendly_type()} is experimental. } } \examples{ friendly_type("logical") friendly_type("integer") friendly_type("string") } \keyword{internal} rlang/man/set_expr.Rd0000644000176200001440000000271113241233650014250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/expr.R \name{set_expr} \alias{set_expr} \alias{get_expr} \title{Set and get an expression} \usage{ set_expr(x, value) get_expr(x, default = x) } \arguments{ \item{x}{An expression, closure, or one-sided formula. In addition, \code{set_expr()} accept frames.} \item{value}{An updated expression.} \item{default}{A default expression to return when \code{x} is not an expression wrapper. Defaults to \code{x} itself.} } \value{ The updated original input for \code{set_expr()}. A raw expression for \code{get_expr()}. } \description{ These helpers are useful to make your function work generically with quosures and raw expressions. First call \code{get_expr()} to extract an expression. Once you're done processing the expression, call \code{set_expr()} on the original object to update the expression. You can return the result of \code{set_expr()}, either a formula or an expression depending on the input type. Note that \code{set_expr()} does not change its input, it creates a new object. } \examples{ f <- ~foo(bar) e <- quote(foo(bar)) frame <- identity(identity(ctxt_frame())) get_expr(f) get_expr(e) get_expr(frame) set_expr(f, quote(baz)) set_expr(e, quote(baz)) } \seealso{ \code{\link[=quo_get_expr]{quo_get_expr()}} and \code{\link[=quo_set_expr]{quo_set_expr()}} for versions of \code{\link[=get_expr]{get_expr()}} and \code{\link[=set_expr]{set_expr()}} that only work on quosures. } rlang/man/rst_abort.Rd0000644000176200001440000000274013241233650014420 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd-restarts.R \name{rst_abort} \alias{rst_abort} \title{Jump to the abort restart} \usage{ rst_abort() } \description{ The abort restart is the only restart that is established at top level. It is used by R as a top-level target, most notably when an error is issued (see \code{\link[=abort]{abort()}}) that no handler is able to deal with (see \code{\link[=with_handlers]{with_handlers()}}). } \examples{ # The `abort` restart is a bit special in that it is always # registered in a R session. You will always find it on the restart # stack because it is established at top level: rst_list() # You can use the `above` restart to jump to top level without # signalling an error: \dontrun{ fn <- function() { cat("aborting...\\n") rst_abort() cat("This is never called\\n") } { fn() cat("This is never called\\n") } } # The `above` restart is the target that R uses to jump to top # level when critical errors are signalled: \dontrun{ { abort("error") cat("This is never called\\n") } } # If another `abort` restart is specified, errors are signalled as # usual but then control flow resumes with from the new restart: \dontrun{ out <- NULL { out <- with_restarts(abort("error"), abort = function() "restart!") cat("This is called\\n") } cat("`out` has now become:", out, "\\n") } } \seealso{ \code{\link[=rst_jump]{rst_jump()}}, \code{\link[=abort]{abort()}} and \code{\link[=cnd_abort]{cnd_abort()}}. } rlang/man/eval_bare.Rd0000644000176200001440000000771213241233650014345 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval.R \name{eval_bare} \alias{eval_bare} \title{Evaluate an expression in an environment} \usage{ eval_bare(expr, env = parent.frame()) } \arguments{ \item{expr}{An expression to evaluate.} \item{env}{The environment in which to evaluate the expression.} } \description{ \code{eval_bare()} is a lower-level version of function \code{\link[base:eval]{base::eval()}}. Technically, it is a simple wrapper around the C function \code{Rf_eval()}. You generally don't need to use \code{eval_bare()} instead of \code{eval()}. Its main advantage is that it handles stack-sensitive (calls such as \code{return()}, \code{on.exit()} or \code{parent.frame()}) more consistently when you pass an enviroment of a frame on the call stack. } \details{ These semantics are possible because \code{eval_bare()} creates only one frame on the call stack whereas \code{eval()} creates two frames, the second of which has the user-supplied environment as frame environment. When you supply an existing frame environment to \code{base::eval()} there will be two frames on the stack with the same frame environment. Stack-sensitive functions only detect the topmost of these frames. We call these evaluation semantics "stack inconsistent". Evaluating expressions in the actual frame environment has useful practical implications for \code{eval_bare()}: \itemize{ \item \code{return()} calls are evaluated in frame environments that might be burried deep in the call stack. This causes a long return that unwinds multiple frames (triggering the \code{on.exit()} event for each frame). By contrast \code{eval()} only returns from the \code{eval()} call, one level up. \item \code{on.exit()}, \code{parent.frame()}, \code{sys.call()}, and generally all the stack inspection functions \code{sys.xxx()} are evaluated in the correct frame environment. This is similar to how this type of calls can be evaluated deep in the call stack because of lazy evaluation, when you force an argument that has been passed around several times. } The flip side of the semantics of \code{eval_bare()} is that it can't evaluate \code{break} or \code{next} expressions even if called within a loop. } \section{Life cycle}{ \code{eval_bare()} is stable. } \examples{ # eval_bare() works just like base::eval() but you have to create # the evaluation environment yourself: eval_bare(quote(foo), env(foo = "bar")) # eval() has different evaluation semantics than eval_bare(). It # can return from the supplied environment even if its an # environment that is not on the call stack (i.e. because you've # created it yourself). The following would trigger an error with # eval_bare(): ret <- quote(return("foo")) eval(ret, env()) # eval_bare(ret, env()) # "no function to return from" error # Another feature of eval() is that you can control surround loops: bail <- quote(break) while (TRUE) { eval(bail) # eval_bare(bail) # "no loop for break/next" error } # To explore the consequences of stack inconsistent semantics, let's # create a function that evaluates `parent.frame()` deep in the call # stack, in an environment corresponding to a frame in the middle of # the stack. For consistency we R's lazy evaluation semantics, we'd # expect to get the caller of that frame as result: fn <- function(eval_fn) { list( returned_env = middle(eval_fn), actual_env = get_env() ) } middle <- function(eval_fn) { deep(eval_fn, get_env()) } deep <- function(eval_fn, eval_env) { expr <- quote(parent.frame()) eval_fn(expr, eval_env) } # With eval_bare(), we do get the expected environment: fn(rlang::eval_bare) # But that's not the case with base::eval(): fn(base::eval) # Another difference of eval_bare() compared to base::eval() is # that it does not insert parasite frames in the evaluation stack: get_stack <- quote(identity(ctxt_stack())) eval_bare(get_stack) eval(get_stack) } \seealso{ \code{\link[=eval_tidy]{eval_tidy()}} for evaluation with data mask and quosure support. } rlang/man/env.Rd0000644000176200001440000001174513241305652013220 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env} \alias{env} \alias{child_env} \alias{new_environment} \title{Create a new environment} \usage{ env(...) child_env(.parent, ...) new_environment(data = list()) } \arguments{ \item{..., data}{Named values. These dots support \link[=tidy-dots]{tidy dots} features.} \item{.parent}{A parent environment. Can be an object supported by \code{\link[=as_environment]{as_environment()}}.} } \description{ These functions create new environments. \itemize{ \item \code{env()} always creates a child of the current environment. \item \code{child_env()} lets you specify a parent (see section on inheritance). \item \code{new_environment()} creates a child of the empty environment. It is useful e.g. for using environments as containers of data rather than as part of a scope hierarchy. } } \section{Environments as objects}{ Environments are containers of uniquely named objects. Their most common use is to provide a scope for the evaluation of R expressions. Not all languages have first class environments, i.e. can manipulate scope as regular objects. Reification of scope is one of the most powerful feature of R as it allows you to change what objects a function or expression sees when it is evaluated. Environments also constitute a data structure in their own right. They are a collection of uniquely named objects, subsettable by name and modifiable by reference. This latter property (see section on reference semantics) is especially useful for creating mutable OO systems (cf the \href{https://github.com/wch/R6}{R6 package} and the \href{http://ggplot2.tidyverse.org/articles/extending-ggplot2.html}{ggprotosystem} for extending ggplot2). } \section{Inheritance}{ All R environments (except the \link[=empty_env]{empty environment}) are defined with a parent environment. An environment and its grandparents thus form a linear hierarchy that is the basis for \href{https://en.wikipedia.org/wiki/Scope_(computer_science)}{lexicalscoping} in R. When R evaluates an expression, it looks up symbols in a given environment. If it cannot find these symbols there, it keeps looking them up in parent environments. This way, objects defined in child environments have precedence over objects defined in parent environments. The ability of overriding specific definitions is used in the tidyeval framework to create powerful domain-specific grammars. A common use of masking is to put data frame columns in scope. See for example \code{\link[=as_data_mask]{as_data_mask()}}. } \section{Reference semantics}{ Unlike regular objects such as vectors, environments are an \link[=is_copyable]{uncopyable} object type. This means that if you have multiple references to a given environment (by assigning the environment to another symbol with \code{<-} or passing the environment as argument to a function), modifying the bindings of one of those references changes all other references as well. } \examples{ # env() creates a new environment which has the current environment # as parent env <- env(a = 1, b = "foo") env$b identical(env_parent(env), get_env()) # child_env() lets you specify a parent: child <- child_env(env, c = "bar") identical(env_parent(child), env) # This child environment owns `c` but inherits `a` and `b` from `env`: env_has(child, c("a", "b", "c", "d")) env_has(child, c("a", "b", "c", "d"), inherit = TRUE) # `parent` is passed to as_environment() to provide handy # shortcuts. Pass a string to create a child of a package # environment: child_env("rlang") env_parent(child_env("rlang")) # Or `NULL` to create a child of the empty environment: child_env(NULL) env_parent(child_env(NULL)) # The base package environment is often a good default choice for a # parent environment because it contains all standard base # functions. Also note that it will never inherit from other loaded # package environments since R keeps the base package at the tail # of the search path: base_child <- child_env("base") env_has(base_child, c("lapply", "("), inherit = TRUE) # On the other hand, a child of the empty environment doesn't even # see a definition for `(` empty_child <- child_env(NULL) env_has(empty_child, c("lapply", "("), inherit = TRUE) # Note that all other package environments inherit from base_env() # as well: rlang_child <- child_env("rlang") env_has(rlang_child, "env", inherit = TRUE) # rlang function env_has(rlang_child, "lapply", inherit = TRUE) # base function # Both env() and child_env() support tidy dots features: objs <- list(b = "foo", c = "bar") env <- env(a = 1, !!! objs) env$c # You can also unquote names with the definition operator `:=` var <- "a" env <- env(!!var := "A") env$a # Use new_environment() to create containers with the empty # environment as parent: env <- new_environment() env_parent(env) # Like other new_ constructors, it takes an object rather than dots: new_environment(list(a = "foo", b = "bar")) } \seealso{ \code{scoped_env}, \code{\link[=env_has]{env_has()}}, \code{\link[=env_bind]{env_bind()}}. } rlang/man/names2.Rd0000644000176200001440000000115413241233650013604 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attr.R \name{names2} \alias{names2} \title{Get names of a vector} \usage{ names2(x) } \arguments{ \item{x}{A vector.} } \description{ This names getter always returns a character vector, even when an object does not have a \code{names} attribute. In this case, it returns a vector of empty names \code{""}. It also standardises missing names to \code{""}. } \section{Life cycle}{ \code{names2()} is stable. } \examples{ names2(letters) # It also takes care of standardising missing names: x <- set_names(1:3, c("a", NA, "b")) names2(x) } rlang/man/splice.Rd0000644000176200001440000000654513241304434013706 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dots.R \name{splice} \alias{splice} \alias{is_spliced} \alias{is_spliced_bare} \alias{dots_splice} \title{Splice lists} \usage{ splice(x) is_spliced(x) is_spliced_bare(x) dots_splice(..., .ignore_empty = c("trailing", "none", "all")) } \arguments{ \item{x}{A list to splice.} \item{...}{Arguments with explicit (\code{dots_list()}) or list (\code{dots_splice()}) splicing semantics. The contents of spliced arguments are embedded in the returned list.} \item{.ignore_empty}{Whether to ignore empty arguments. Can be one of \code{"trailing"}, \code{"none"}, \code{"all"}. If \code{"trailing"}, only the last argument is ignored if it is empty.} } \description{ \itemize{ \item \code{splice} marks an object to be spliced. It is equivalent to using \code{!!!} in a function with \link[=tidy-dots]{tidy dots semantics}. } } \details{ \itemize{ \item \code{dots_splice()} is like \code{\link[=dots_list]{dots_list()}} but automatically splices list inputs. } } \section{Standard splicing versus quoting splicing}{ The \code{!!!} operator works differently in \emph{standard} functions taking dots with \code{dots_list()} than in \emph{quoting} functions taking dots with \code{\link[=enexprs]{enexprs()}} or \code{\link[=enquos]{enquos()}}. \itemize{ \item In quoting functions \code{!!!} disaggregates its argument (let's call it \code{x}) into as many objects as there are elements in \code{x}. E.g. \code{quo(foo(!!! c(1, 2)))} is completely equivalent to \code{quo(foo(1, 2))}. The creation of those separate objects has an overhead but is typically not important when manipulating calls because function calls typically take a small number of arguments. \item In standard functions, disaggregating the spliced collection would have a negative performance impact in cases where \code{dots_list()} is used to build up data structures from user inputs. To avoid this spliced inputs are marked with \code{\link[=splice]{splice()}} and the final list is built with (the equivalent of) \code{flatten_if(dots, is_spliced)}. } Most of the time you should not care about the difference. However if you use a standard function taking tidy dots within a quoting function, the \code{!!!} operator will disaggregate its argument because the behaviour of the quasiquoting function has priority. You might then observe some performance cost in edge cases. Here is one example where this would happen:\preformatted{purrr::rerun(10, dplyr::bind_rows(!!! x)) } \code{purrr::rerun()} is a quoting function and \code{dplyr::bind_rows()} is a standard function. Because \code{bind_rows()} is called \emph{inside} \code{rerun()}, the list \code{x} will be disaggregated into a pairlist of arguments. To avoid this you can use \code{splice()} instead:\preformatted{purrr::rerun(10, dplyr::bind_rows(splice(x))) } } \section{Life cycle}{ \itemize{ \item \code{dots_splice()} is in \strong{questioning} stage. It is part of our experiments with dots semantics. Compared to \code{dots_list()}, \code{dots_splice()} automatically splices lists. We now lean towards adopting a single type of dots semantics (those of \code{dots_list()}) where splicing is explicit. \item \code{splice()} is in questioning stage. It is not clear whether it is really needed as there are other ways to avoid the performance issue discussed in the section above. } } \keyword{internal} rlang/man/call_modify.Rd0000644000176200001440000000376113241305652014711 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{call_modify} \alias{call_modify} \title{Modify the arguments of a call} \usage{ call_modify(.call, ..., .standardise = FALSE, .env = caller_env()) } \arguments{ \item{.call}{Can be a call, a formula quoting a call in the right-hand side, or a frame object from which to extract the call expression.} \item{...}{Named or unnamed expressions (constants, names or calls) used to modify the call. Use \code{NULL} to remove arguments. These dots support \link[=tidy-dots]{tidy dots} features.} \item{.standardise}{If \code{TRUE}, the call is standardised beforehand to match existing unnamed arguments to their argument names. This prevents new named arguments from accidentally replacing original unnamed arguments.} \item{.env}{The environment where to find the \code{call} definition in case \code{call} is not wrapped in a quosure. This is passed to \code{call_standardise()} if \code{.standardise} is \code{TRUE}.} } \value{ A quosure if \code{.call} is a quosure, a call otherwise. } \description{ Modify the arguments of a call } \section{Life cycle}{ In rlang 0.2.0, \code{lang_modify()} was soft-deprecated and renamed to \code{call_modify()}. See lifecycle section in \code{\link[=call2]{call2()}} for more about this change. } \examples{ call <- quote(mean(x, na.rm = TRUE)) # Modify an existing argument call_modify(call, na.rm = FALSE) call_modify(call, x = quote(y)) # Remove an argument call_modify(call, na.rm = NULL) # Add a new argument call_modify(call, trim = 0.1) # Add an explicit missing argument call_modify(call, na.rm = quote(expr = )) # Supply a list of new arguments with `!!!` newargs <- list(na.rm = NULL, trim = 0.1) call_modify(call, !!! newargs) # Supply a call frame to extract the frame expression: f <- function(bool = TRUE) { call_modify(call_frame(), splice(list(bool = FALSE))) } f() # You can also modify quosures inplace: f <- quo(matrix(bar)) call_modify(f, quote(foo)) } \seealso{ lang } rlang/man/has_name.Rd0000644000176200001440000000127313241233650014174 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attr.R \name{has_name} \alias{has_name} \title{Does an object have an element with this name?} \usage{ has_name(x, name) } \arguments{ \item{x}{A data frame or another named object} \item{name}{Element name(s) to check} } \value{ A logical vector of the same length as \code{name} } \description{ This function returns a logical value that indicates if a data frame or another named object contains an element with a specific name. } \details{ Unnamed objects are treated as if all names are empty strings. \code{NA} input gives \code{FALSE} as output. } \examples{ has_name(iris, "Species") has_name(mtcars, "gears") } rlang/man/set_names.Rd0000644000176200001440000000246513241233650014403 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attr.R \name{set_names} \alias{set_names} \title{Set names of a vector} \usage{ set_names(x, nm = x, ...) } \arguments{ \item{x}{Vector to name.} \item{nm, ...}{Vector of names, the same length as \code{x}. You can specify names in the following ways: \itemize{ \item If you do nothing, \code{x} will be named with itself. \item If \code{x} already has names, you can provide a function or formula to transform the existing names. In that case, \code{...} is passed to the function. \item If \code{nm} is \code{NULL}, the names are removed (if present). \item In all other cases, \code{nm} and \code{...} are coerced to character. }} } \description{ This is equivalent to \code{\link[stats:setNames]{stats::setNames()}}, with more features and stricter argument checking. } \section{Life cycle}{ \code{set_names()} is stable and exported in purrr. } \examples{ set_names(1:4, c("a", "b", "c", "d")) set_names(1:4, letters[1:4]) set_names(1:4, "a", "b", "c", "d") # If the second argument is ommitted a vector is named with itself set_names(letters[1:5]) # Alternatively you can supply a function set_names(1:10, ~ letters[seq_along(.)]) set_names(head(mtcars), toupper) # `...` is passed to the function: set_names(head(mtcars), paste0, "_foo") } rlang/man/new_function.Rd0000644000176200001440000000227113241233650015116 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fn.R \name{new_function} \alias{new_function} \title{Create a function} \usage{ new_function(args, body, env = caller_env()) } \arguments{ \item{args}{A named list of default arguments. Note that if you want arguments that don't have defaults, you'll need to use the special function \link{alist}, e.g. \code{alist(a = , b = 1)}} \item{body}{A language object representing the code inside the function. Usually this will be most easily generated with \code{\link[base:quote]{base::quote()}}} \item{env}{The parent environment of the function, defaults to the calling environment of \code{new_function()}} } \description{ This constructs a new function given it's three components: list of arguments, body code and parent environment. } \examples{ f <- function(x) x + 3 g <- new_function(alist(x = ), quote(x + 3)) # The components of the functions are identical identical(formals(f), formals(g)) identical(body(f), body(g)) identical(environment(f), environment(g)) # But the functions are not identical because f has src code reference identical(f, g) attr(f, "srcref") <- NULL # Now they are: stopifnot(identical(f, g)) } rlang/man/prepend.Rd0000644000176200001440000000164313241233650014057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-utils.R \name{prepend} \alias{prepend} \title{Prepend a vector} \usage{ prepend(x, values, before = 1) } \arguments{ \item{x}{the vector to be modified.} \item{values}{to be included in the modified vector.} \item{before}{a subscript, before which the values are to be appended.} } \value{ A merged vector. } \description{ This is a companion to \code{\link[base:append]{base::append()}} to help merging two lists or atomic vectors. \code{prepend()} is a clearer semantic signal than \code{c()} that a vector is to be merged at the beginning of another, especially in a pipe chain. } \section{Life cycle}{ \code{prepend()} is experimental, expect API changes. We are still figuring out what vector tools belong in rlang. } \examples{ x <- as.list(1:3) append(x, "a") prepend(x, "a") prepend(x, list("a", "b"), before = 3) } \keyword{internal} rlang/man/new-vector.Rd0000644000176200001440000000176313242734435014526 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-new.R \name{new-vector} \alias{new-vector} \alias{new_logical} \alias{new_integer} \alias{new_double} \alias{new_character} \alias{new_complex} \alias{new_raw} \alias{new_list} \title{Create vectors matching a given length} \usage{ new_logical(n, names = NULL) new_integer(n, names = NULL) new_double(n, names = NULL) new_character(n, names = NULL) new_complex(n, names = NULL) new_raw(n, names = NULL) new_list(n, names = NULL) } \arguments{ \item{n}{The vector length.} \item{names}{Names for the new vector.} } \description{ These functions construct vectors of given length, with attributes specified via dots. Except for \code{new_list()} and \code{new_bytes()}, the empty vectors are filled with typed \link{missing} values. This is in contrast to the base function \code{\link[base:vector]{base::vector()}} which creates zero-filled vectors. } \examples{ new_list(10) new_logical(10) } \seealso{ new-vector-along } rlang/man/ns_env.Rd0000644000176200001440000000161413241233650013710 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{ns_env} \alias{ns_env} \alias{ns_imports_env} \alias{ns_env_name} \title{Get the namespace of a package} \usage{ ns_env(pkg = NULL) ns_imports_env(pkg = NULL) ns_env_name(pkg = NULL) } \arguments{ \item{pkg}{The name of a package. If \code{NULL}, the surrounding namespace is returned, or an error is issued if not called within a namespace. If a function, the enclosure of that function is checked.} } \description{ Namespaces are the environment where all the functions of a package live. The parent environments of namespaces are the \code{imports} environments, which contain all the functions imported from other packages. } \section{Life cycle}{ These functions are experimental and may not belong to the rlang package. Expect API changes. } \seealso{ \code{\link[=pkg_env]{pkg_env()}} } \keyword{internal} rlang/man/quotation.Rd0000644000176200001440000002135013241304434014441 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quotation.R \name{quotation} \alias{quotation} \alias{expr} \alias{enexpr} \alias{exprs} \alias{enexprs} \alias{ensym} \alias{ensyms} \alias{quo} \alias{enquo} \alias{quos} \alias{enquos} \title{Quotation} \usage{ expr(expr) enexpr(arg) exprs(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) enexprs(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) ensym(arg) ensyms(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) quo(expr) enquo(arg) quos(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) enquos(..., .named = FALSE, .ignore_empty = c("trailing", "none", "all"), .unquote_names = TRUE) } \arguments{ \item{expr}{An expression.} \item{arg}{A symbol representing an argument. The expression supplied to that argument will be captured instead of being evaluated.} \item{...}{For \code{enexprs()}, \code{ensyms()} and \code{enquos()}, names of arguments to capture without evaluation (including \code{...}). For \code{exprs()} and \code{quos()}, the expressions to capture unevaluated (including expressions contained in \code{...}).} \item{.named}{Whether to ensure all dots are named. Unnamed elements are processed with \code{\link[=expr_text]{expr_text()}} to figure out a default name. If an integer, it is passed to the \code{width} argument of \code{expr_text()}, if \code{TRUE}, the default width is used. See \code{\link[=exprs_auto_name]{exprs_auto_name()}}.} \item{.ignore_empty}{Whether to ignore empty arguments. Can be one of \code{"trailing"}, \code{"none"}, \code{"all"}. If \code{"trailing"}, only the last argument is ignored if it is empty.} \item{.unquote_names}{Whether to treat \code{:=} as \code{=}. Unlike \code{=}, the \code{:=} syntax supports \code{!!} unquoting on the LHS.} } \description{ Quotation is a mechanism by which an expression supplied as argument is captured by a function. Instead of seeing the value of the argument, the function sees the recipe (the R code) to make that value. This is possible because R \link[=is_expr]{expressions} are representable as regular objects in R: \itemize{ \item Calls represent the action of calling a function to compute a new value. Evaluating a call causes that value to be computed. Calls typically involve symbols to reference R objects. \item Symbols represent the name that is given to an object in a particular context (an \link[=env]{environment}). } We call objects containing calls and symbols \link[=is_expr]{expressions}. There are two ways to create R expressions. First you can \strong{build} calls and symbols from parts and pieces (see \code{\link[=sym]{sym()}}, \code{\link[=syms]{syms()}} and \code{\link[=call2]{call2()}}). The other way is by \emph{quotation} or \emph{quasiquotation}, i.e. by intercepting an expression instead of evaluating it. } \section{User expressions versus your expressions}{ There are two points of view when it comes to capturing an expression: \itemize{ \item You can capture the expressions supplied by \emph{the user} of your function. This is the purpose of \code{ensym()}, \code{enexpr()} and \code{enquo()} and their plural variants. These functions take an argument name and capture the expression that was supplied to that argument. \item You can capture the expressions that \emph{you} supply. To this end use \code{expr()} and \code{quo()} and their plural variants \code{exprs()} and \code{quos()}. } } \section{Capture raw expressions}{ \itemize{ \item \code{enexpr()} and \code{expr()} capture a single raw expression. \item \code{enexprs()} and \code{exprs()} capture a list of raw expressions including expressions contained in \code{...}. \item \code{ensym()} and \code{ensyms()} are variants of \code{enexpr()} and \code{enexprs()} that check the captured expression is either a string (which they convert to symbol) or a symbol. If anything else is supplied they throw an error. } In terms of base functions, \code{enexpr(arg)} corresponds to \code{base::substitute(arg)} (though that function has complex semantics) and \code{expr()} is like \code{\link[=quote]{quote()}} (and \code{\link[=bquote]{bquote()}} if we consider unquotation syntax). The plural variant \code{exprs()} is equivalent to \code{\link[base:alist]{base::alist()}}. Finally there is no function in base R that is equivalent to \code{enexprs()} but you can reproduce its behaviour with \code{eval(substitute(alist(...)))}. } \section{Capture expressions in quosures}{ \code{quo()} and \code{enquo()} are similar to their \code{expr} counterparts but capture both the expression and its environment in an object called a quosure. This wrapper contains a reference to the original environment in which that expression was captured. Keeping track of the environments of expressions is important because this is where functions and objects mentioned in the expression are defined. Quosures are objects that can be evaluated with \code{\link[=eval_tidy]{eval_tidy()}} just like symbols or function calls. Since they always evaluate in their original environment, quosures can be seen as a vehicle that allow expressions to travel from function to function but that beam back instantly to their original environment upon evaluation. See the \link{quosure} help topic about tools to work with quosures. } \section{Quasiquotation}{ All quotation functions in rlang have support for \link[=quasiquotation]{unquoting operators}. The combination of quotation and unquotation is called \emph{quasiquotation}. Unquotation provides a way to refer to variables during quotation. Variables are problematic when quoting because a captured expression is essentially a constant, just like a string is a constant. For instance in all the following cases \code{apple} is a constant: \code{~apple}, \code{"apple"} and \code{expr(apple)}. Unquoting allows you to introduce a part of variability within a captured expression. \itemize{ \item In the case of \code{enexpr()} and \code{enquo()}, unquoting provides an escape hatch to the users of your function that allows them to manipulate the expression that you capture. \item In the case of \code{expr()} and \code{quo()}, quasiquotation lets you build a complex expressions where some parts are constant (the parts that are captured) and some parts are variable (the parts that are unquoted). } See the \link{quasiquotation} help topic for more about this as well as \href{https://adv-r.hadley.nz/quasiquotation.html}{the chapter in Advanced R}. } \section{Life cycle}{ All the quotation functions mentioned here are stable. } \examples{ # expr() and exprs() capture expressions that you supply: expr(symbol) exprs(several, such, symbols) # enexpr() and enexprs() capture expressions that your user supplied: expr_inputs <- function(arg, ...) { user_exprs <- enexprs(arg, ...) user_exprs } expr_inputs(hello) expr_inputs(hello, bonjour, ciao) # ensym() and ensyms() provide additional type checking to ensure # the user calling your function has supplied bare object names: sym_inputs <- function(...) { user_symbols <- ensyms(...) user_symbols } sym_inputs(hello, "bonjour") ## sym_inputs(say(hello)) # Error: Must supply symbols or strings expr_inputs(say(hello)) # All these quoting functions have quasiquotation support. This # means that you can unquote (evaluate and inline) part of the # captured expression: what <- sym("bonjour") expr(say(what)) expr(say(!!what)) # This also applies to the expressions supplied the user. This is # like an escape hatch that allows control over the captured # expression: expr_inputs(say(!!what), !!what) # Finally, you can capture expressions as quosures. A quosure is an # object that contains both the expression and its environment: quo <- quo(letters) quo get_expr(quo) get_env(quo) # Quosures can be evaluated with eval_tidy(): eval_tidy(quo) # They have the nice property that you can pass them around from # context to context (that is, from function to function) and they # still evaluate in their original environment: multiply_expr_by_10 <- function(expr) { # We capture the user expression and its environment: expr <- enquo(expr) # Then create an object that only exists in this function: local_ten <- 10 # Now let's create a multiplication expression that (a) inlines # the user expression as LHS (still wrapped in its quosure) and # (b) refers to the local object in the RHS: quo(!!expr * local_ten) } quo <- multiply_expr_by_10(2 + 3) # The local parts of the quosure are printed in colour if your # terminal is capable of displaying colours: quo # All the quosures in the expression evaluate in their original # context. The local objects are looked up properly and we get the # expected result: eval_tidy(quo) } rlang/man/is_integerish.Rd0000644000176200001440000000217613241233650015260 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{is_integerish} \alias{is_integerish} \alias{is_bare_integerish} \alias{is_scalar_integerish} \title{Is a vector integer-like?} \usage{ is_integerish(x, n = NULL, finite = TRUE) is_bare_integerish(x, n = NULL) is_scalar_integerish(x) } \arguments{ \item{x}{Object to be tested.} \item{n}{Expected length of a vector.} \item{finite}{Whether values must be finite. Examples of non-finite values are \code{Inf}, \code{-Inf} and \code{NaN}.} } \description{ These predicates check whether R considers a number vector to be integer-like, according to its own tolerance check (which is in fact delegated to the C library). This function is not adapted to data analysis, see the help for \code{\link[base:is.integer]{base::is.integer()}} for examples of how to check for whole numbers. } \examples{ is_integerish(10L) is_integerish(10.0) is_integerish(10.0, n = 2) is_integerish(10.000001) is_integerish(TRUE) } \seealso{ \code{\link[=is_bare_numeric]{is_bare_numeric()}} for testing whether an object is a base numeric type (a bare double or integer vector). } rlang/man/fn_body.Rd0000644000176200001440000000100513241233650014032 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fn.R \name{fn_body} \alias{fn_body} \alias{fn_body<-} \title{Get or set function body} \usage{ fn_body(fn = caller_fn()) fn_body(fn) <- value } \arguments{ \item{fn}{A function. It is lookep up in the calling frame if not supplied.} \item{value}{New formals or formals names for \code{fn}.} } \description{ \code{fn_body()} is a simple wrapper around \code{base::body()}. The setter version preserves attributes, unlike \code{body<-}. } rlang/man/as_overscope.Rd0000644000176200001440000000230013241233650015101 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{as_overscope} \alias{as_overscope} \alias{new_overscope} \alias{overscope_clean} \title{Create an overscope} \usage{ as_overscope(quo, data = NULL) new_overscope(bottom, top = NULL, enclosure = base_env()) overscope_clean(overscope) } \arguments{ \item{quo}{A \link[=quotation]{quosure}.} \item{data}{A data frame or named vector of masking data.} \item{bottom}{The environment containing masking objects if the data mask is one environment deep. The bottom environment if the data mask comprises multiple environment.} \item{top}{The last environment of the data mask. If the data mask is only one environment deep, \code{top} should be the same as \code{bottom}.} \item{enclosure}{The \code{parent} argument of \code{\link[=new_data_mask]{new_data_mask()}}.} \item{overscope}{A data mask.} } \description{ These functions have been soft-deprecated in rlang 0.2.0. Please use \code{\link[=as_data_mask]{as_data_mask()}} and \code{\link[=new_data_mask]{new_data_mask()}} instead. We no longer require the mask to be cleaned up so \code{overscope_clean()} does not have a replacement. } \keyword{internal} rlang/man/env_poke.Rd0000644000176200001440000000353613241233650014233 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_poke} \alias{env_poke} \title{Poke an object in an environment} \usage{ env_poke(env = caller_env(), nm, value, inherit = FALSE, create = NULL) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{nm}{Names of bindings. \code{nm} must be a single string.} \item{value}{The value for a new binding.} \item{inherit}{Whether to look for bindings in the parent environments.} \item{create}{Whether to create a binding if it does not already exist in the environment.} } \description{ \code{env_poke()} will assign or reassign a binding in \code{env} if \code{create} is \code{TRUE}. If \code{create} is \code{FALSE} and a binding does not already exists, an error is issued. } \details{ If \code{inherit} is \code{TRUE}, the parents environments are checked for an existing binding to reassign. If not found and \code{create} is \code{TRUE}, a new binding is created in \code{env}. The default value for \code{create} is a function of \code{inherit}: \code{FALSE} when inheriting, \code{TRUE} otherwise. This default makes sense because the inheriting case is mostly for overriding an existing binding. If not found, something probably went wrong and it is safer to issue an error. Note that this is different to the base R operator \code{<<-} which will create a binding in the global environment instead of the current environment when no existing binding is found in the parents. } \section{Life cycle}{ \code{env_poke()} is experimental. We are still experimenting with reducing the number of redundant functions by using quasiquotation. It is possible \code{env_poke()} will be deprecated in favour of \code{env_bind()} and name-unquoting with \code{:=}. } \keyword{internal} rlang/man/f_rhs.Rd0000644000176200001440000000154313241233650013522 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formula.R \name{f_rhs} \alias{f_rhs} \alias{f_rhs<-} \alias{f_lhs} \alias{f_lhs<-} \alias{f_env} \alias{f_env<-} \title{Get or set formula components} \usage{ f_rhs(f) f_rhs(x) <- value f_lhs(f) f_lhs(x) <- value f_env(f) f_env(x) <- value } \arguments{ \item{f, x}{A formula} \item{value}{The value to replace with.} } \value{ \code{f_rhs} and \code{f_lhs} return language objects (i.e. atomic vectors of length 1, a name, or a call). \code{f_env} returns an environment. } \description{ \code{f_rhs} extracts the righthand side, \code{f_lhs} extracts the lefthand side, and \code{f_env} extracts the environment. All functions throw an error if \code{f} is not a formula. } \examples{ f_rhs(~ 1 + 2 + 3) f_rhs(~ x) f_rhs(~ "A") f_rhs(1 ~ 2) f_lhs(~ y) f_lhs(x ~ y) f_env(~ x) } rlang/man/fn_env.Rd0000644000176200001440000000201513241233650013667 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fn.R \name{fn_env} \alias{fn_env} \alias{fn_env<-} \title{Return the closure environment of a function} \usage{ fn_env(fn) fn_env(x) <- value } \arguments{ \item{fn, x}{A function.} \item{value}{A new closure environment for the function.} } \description{ Closure environments define the scope of functions (see \code{\link[=env]{env()}}). When a function call is evaluated, R creates an evaluation frame (see \code{\link[=ctxt_stack]{ctxt_stack()}}) that inherits from the closure environment. This makes all objects defined in the closure environment and all its parents available to code executed within the function. } \details{ \code{fn_env()} returns the closure environment of \code{fn}. There is also an assignment method to set a new closure environment. } \examples{ env <- child_env("base") fn <- with_env(env, function() NULL) identical(fn_env(fn), env) other_env <- child_env("base") fn_env(fn) <- other_env identical(fn_env(fn), other_env) } rlang/man/frame_position.Rd0000644000176200001440000000366013241233650015441 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{frame_position} \alias{frame_position} \title{Find the position or distance of a frame on the evaluation stack} \usage{ frame_position(frame, from = c("global", "current")) } \arguments{ \item{frame}{The environment of a frame. Can be any object with a \code{\link[=get_env]{get_env()}} method. Note that for frame objects, the position from the global frame is simply \code{frame$pos}. Alternatively, \code{frame} can be an integer that represents the position on the stack (and is thus returned as is if \code{from} is "global".} \item{from}{Whether to compute distance from the global frame (the bottom of the evaluation stack), or from the current frame (the top of the evaluation stack).} } \description{ The frame position on the stack can be computed by counting frames from the global frame (the bottom of the stack, the default) or from the current frame (the top of the stack). } \details{ While this function returns the position of the frame on the evaluation stack, it can safely be called with intervening frames as those will be discarded. } \section{Life cycle}{ These functions are in the questioning stage. We are no longer convinced they belong in rlang as they are mostly for REPL interaction and runtime inspection rather than function development. } \examples{ fn <- function() g(environment()) g <- function(env) frame_position(env) # frame_position() returns the position of the frame on the evaluation stack: fn() identity(identity(fn())) # Note that it trims off intervening calls before counting so you # can safely nest it within other calls: g <- function(env) identity(identity(frame_position(env))) fn() # You can also ask for the position from the current frame rather # than the global frame: fn <- function() g(environment()) g <- function(env) h(env) h <- function(env) frame_position(env, from = "current") fn() } \keyword{internal} rlang/man/lang_head.Rd0000644000176200001440000000066213241233650014324 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{lang_head} \alias{lang_head} \alias{lang_tail} \title{Return the head or tail of a call} \usage{ lang_head(lang) lang_tail(lang) } \arguments{ \item{lang}{A call.} } \description{ As of rlang 0.2.0 these functions are retired (soft-deprecated for now) because they are low level accessors that are rarely needed for end users. } rlang/man/expr_print.Rd0000644000176200001440000000370513241233650014615 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/expr.R \name{expr_print} \alias{expr_print} \alias{expr_deparse} \title{Print an expression} \usage{ expr_print(x, width = peek_option("width")) expr_deparse(x, width = peek_option("width")) } \arguments{ \item{x}{An object or expression to print.} \item{width}{The width of the deparsed or printed expression. Defaults to the global option \code{width}.} } \description{ \code{expr_print()}, powered by \code{expr_deparse()}, is an alternative printer for R expressions with a few improvements over the base R printer. \itemize{ \item It colourises \link[=quotation]{quosures} according to their environment. Quosures from the global environment are printed normally while quosures from local environments are printed in unique colour (or in italic when all colours are taken). \item It wraps inlined objects in angular brackets. For instance, an integer vector unquoted in a function call (e.g. \code{expr(foo(!!(1:3)))}) is printed like this: \code{foo()} while by default R prints the code to create that vector: \code{foo(1:3)} which is ambiguous. \item It respects the width boundary (from the global option \code{width}) in more cases. } } \examples{ # It supports any object. Non-symbolic objects are always printed # within angular brackets: expr_print(1:3) expr_print(function() NULL) # Contrast this to how the code to create these objects is printed: expr_print(quote(1:3)) expr_print(quote(function() NULL)) # The main cause of non-symbolic objects in expressions is # quasiquotation: expr_print(expr(foo(!!(1:3)))) # Quosures from the global environment are printed normally: expr_print(quo(foo)) expr_print(quo(foo(!!quo(bar)))) # Quosures from local environments are colourised according to # their environments (if you have crayon installed): local_quo <- local(quo(foo)) expr_print(local_quo) wrapper_quo <- local(quo(bar(!!local_quo, baz))) expr_print(wrapper_quo) } rlang/man/env_names.Rd0000644000176200001440000000333013241233650014370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_names} \alias{env_names} \title{Names of symbols bound in an environment} \usage{ env_names(env) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} } \value{ A character vector of object names. } \description{ \code{env_names()} returns object names from an enviroment \code{env} as a character vector. All names are returned, even those starting with a dot. } \section{Names of symbols and objects}{ Technically, objects are bound to symbols rather than strings, since the R interpreter evaluates symbols (see \code{\link[=is_expression]{is_expression()}} for a discussion of symbolic objects versus literal objects). However it is often more convenient to work with strings. In rlang terminology, the string corresponding to a symbol is called the \emph{name} of the symbol (or by extension the name of an object bound to a symbol). } \section{Encoding}{ There are deep encoding issues when you convert a string to symbol and vice versa. Symbols are \emph{always} in the native encoding (see \code{\link[=set_chr_encoding]{set_chr_encoding()}}). If that encoding (let's say latin1) cannot support some characters, these characters are serialised to ASCII. That's why you sometimes see strings looking like \code{}, especially if you're running Windows (as R doesn't support UTF-8 as native encoding on that platform). To alleviate some of the encoding pain, \code{env_names()} always returns a UTF-8 character vector (which is fine even on Windows) with unicode points unserialised. } \examples{ env <- env(a = 1, b = 2) env_names(env) } rlang/man/missing.Rd0000644000176200001440000000356013241233650014073 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-na.R \docType{data} \name{missing} \alias{missing} \alias{na_lgl} \alias{na_int} \alias{na_dbl} \alias{na_chr} \alias{na_cpl} \title{Missing values} \format{An object of class \code{logical} of length 1.} \usage{ na_lgl na_int na_dbl na_chr na_cpl } \description{ Missing values are represented in R with the general symbol \code{NA}. They can be inserted in almost all data containers: all atomic vectors except raw vectors can contain missing values. To achieve this, R automatically converts the general \code{NA} symbol to a typed missing value appropriate for the target vector. The objects provided here are aliases for those typed \code{NA} objects. } \details{ Typed missing values are necessary because R needs sentinel values of the same type (i.e. the same machine representation of the data) as the containers into which they are inserted. The official typed missing values are \code{NA_integer_}, \code{NA_real_}, \code{NA_character_} and \code{NA_complex_}. The missing value for logical vectors is simply the default \code{NA}. The aliases provided in rlang are consistently named and thus simpler to remember. Also, \code{na_lgl} is provided as an alias to \code{NA} that makes intent clearer. Since \code{na_lgl} is the default \code{NA}, expressions such as \code{c(NA, NA)} yield logical vectors as no data is available to give a clue of the target type. In the same way, since lists and environments can contain any types, expressions like \code{list(NA)} store a logical \code{NA}. } \examples{ typeof(NA) typeof(na_lgl) typeof(na_int) # Note that while the base R missing symbols cannot be overwritten, # that's not the case for rlang's aliases: na_dbl <- NA typeof(na_dbl) } \seealso{ The \link{new-vector-along} family to create typed vectors filled with missing values. } \keyword{datasets} rlang/man/overscope_eval_next.Rd0000644000176200001440000000142313241233650016470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{overscope_eval_next} \alias{overscope_eval_next} \title{Evaluate next quosure in a data mask} \usage{ overscope_eval_next(overscope, quo, env = base_env()) } \arguments{ \item{overscope}{A valid overscope containing bindings for \code{~}, \code{.top_env} and \code{_F} and whose parents contain overscoped bindings for tidy evaluation.} \item{quo}{A quosure.} \item{env}{The lexical enclosure in case \code{quo} is not a validly scoped quosure. This is the \link[=base_env]{base environment} by default.} } \description{ \code{overscope_eval_next()} is soft-deprecated as of rlang 0.2.0. Please use \code{eval_tidy()} to which you can now supply an overscope. } \keyword{internal} rlang/man/new-vector-along.Rd0000644000176200001440000000273613242734435015625 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-new.R \name{new-vector-along} \alias{new-vector-along} \alias{new_logical_along} \alias{new_integer_along} \alias{new_double_along} \alias{new_character_along} \alias{new_complex_along} \alias{new_raw_along} \alias{new_list_along} \alias{rep_along} \title{Create vectors matching the length of a given vector} \usage{ new_logical_along(x, names = base::names(x)) new_integer_along(x, names = base::names(x)) new_double_along(x, names = base::names(x)) new_character_along(x, names = base::names(x)) new_complex_along(x, names = base::names(x)) new_raw_along(x, names = base::names(x)) new_list_along(x, names = base::names(x)) rep_along(.x, .y) } \arguments{ \item{x, .x}{A vector.} \item{names}{Names for the new vector. Defaults to the names of \code{x}. This can be a function to apply to the names of \code{x} as in \code{\link[=set_names]{set_names()}}.} \item{.y}{Values to repeat.} } \description{ These functions take the idea of \code{\link[=seq_along]{seq_along()}} and generalise it to creating lists (\code{new_list_along}) and repeating values (\code{rep_along}). Except for \code{new_list_along()} and \code{new_raw_along()}, the empty vectors are filled with typed \code{missing} values. } \examples{ x <- 0:5 rep_along(x, 1:2) rep_along(x, 1) new_list_along(x) # The default names are picked up from the input vector x <- c(a = "foo", b = "bar") new_character_along(x) } \seealso{ new-vector } rlang/man/exiting.Rd0000644000176200001440000000553513241233650014075 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd-handlers.R \name{exiting} \alias{exiting} \alias{inplace} \title{Create an exiting or in place handler} \usage{ exiting(handler) inplace(handler, muffle = FALSE) } \arguments{ \item{handler}{A handler function that takes a condition as argument. This is passed to \code{\link[=as_function]{as_function()}} and can thus be a formula describing a lambda function.} \item{muffle}{Whether to muffle the condition after executing an inplace handler. The signalling function must have established a muffling restart. Otherwise, an error will be issued.} } \description{ There are two types of condition handlers: exiting handlers, which are thrown to the place where they have been established (e.g., \code{\link[=with_handlers]{with_handlers()}}'s evaluation frame), and local handlers, which are executed in place (e.g., where the condition has been signalled). \code{exiting()} and \code{inplace()} create handlers suitable for \code{\link[=with_handlers]{with_handlers()}}. } \details{ A subtle point in the R language is that conditions are not thrown, handlers are. \code{\link[base:tryCatch]{base::tryCatch()}} and \code{\link[=with_handlers]{with_handlers()}} actually catch handlers rather than conditions. When a critical condition signalled with \code{\link[base:stop]{base::stop()}} or \code{\link[=abort]{abort()}}, R inspects the handler stack and looks for a handler that can deal with the condition. If it finds an exiting handler, it throws it to the function that established it (\code{\link[=with_handlers]{with_handlers()}}). That is, it interrupts the normal course of evaluation and jumps to \code{with_handlers()} evaluation frame (see \code{\link[=ctxt_stack]{ctxt_stack()}}), and only then and there the handler is called. On the other hand, if R finds an inplace handler, it executes it locally. The inplace handler can choose to handle the condition by jumping out of the frame (see \code{\link[=rst_jump]{rst_jump()}} or \code{\link[=return_from]{return_from()}}). If it returns locally, it declines to handle the condition which is passed to the next relevant handler on the stack. If no handler is found or is able to deal with the critical condition (by jumping out of the frame), R will then jump out of the faulty evaluation frame to top-level, via the abort restart (see \code{\link[=rst_abort]{rst_abort()}}). } \examples{ # You can supply a function taking a condition as argument: hnd <- exiting(function(c) cat("handled foo\\n")) with_handlers(cnd_signal("foo"), foo = hnd) # Or a lambda-formula where "." is bound to the condition: with_handlers(foo = inplace(~cat("hello", .$attr, "\\n")), { cnd_signal("foo", attr = "there") "foo" }) } \seealso{ \code{\link[=with_handlers]{with_handlers()}} for examples, \code{\link[=restarting]{restarting()}} for another kind of inplace handler. } rlang/man/is_condition.Rd0000644000176200001440000000041013241233650015072 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd.R \name{is_condition} \alias{is_condition} \title{Is object a condition?} \usage{ is_condition(x) } \arguments{ \item{x}{An object to test.} } \description{ Is object a condition? } rlang/man/inherits_any.Rd0000644000176200001440000000304513241233650015114 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/s3.R \name{inherits_any} \alias{inherits_any} \alias{inherits_all} \alias{inherits_only} \title{Does an object inherit from a set of classes?} \usage{ inherits_any(x, class) inherits_all(x, class) inherits_only(x, class) } \arguments{ \item{x}{An object to test for inheritance.} \item{class}{A character vector of classes.} } \description{ \itemize{ \item \code{inherits_any()} is like \code{\link[base:inherits]{base::inherits()}} but is more explicit about its behaviour with multiple classes. If \code{classes} contains several elements and the object inherits from at least one of them, \code{inherits_any()} returns \code{TRUE}. \item \code{inherits_all()} tests that an object inherits from all of the classes in the supplied order. This is usually the best way to test for inheritance of multiple classes. \item \code{inherits_only()} tests that the class vectors are identical. It is a shortcut for \code{identical(class(x), class)}. } } \examples{ obj <- structure(list(), class = c("foo", "bar", "baz")) # With the _any variant only one class must match: inherits_any(obj, c("foobar", "bazbaz")) inherits_any(obj, c("foo", "bazbaz")) # With the _all variant all classes must match: inherits_all(obj, c("foo", "bazbaz")) inherits_all(obj, c("foo", "baz")) # The order of classes must match as well: inherits_all(obj, c("baz", "foo")) # inherits_only() checks that the class vectors are identical: inherits_only(obj, c("foo", "baz")) inherits_only(obj, c("foo", "bar", "baz")) } rlang/man/call_fn.Rd0000644000176200001440000000173013241233650014015 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{call_fn} \alias{call_fn} \title{Extract function from a call} \usage{ call_fn(call, env = caller_env()) } \arguments{ \item{call}{Can be a call or a quosure that wraps a call.} \item{env}{The environment where to find the definition of the function quoted in \code{call} in case \code{call} is not wrapped in a quosure.} } \description{ If a frame or formula, the function will be retrieved from the associated environment. Otherwise, it is looked up in the calling frame. } \section{Life cycle}{ In rlang 0.2.0, \code{lang_fn()} was soft-deprecated and renamed to \code{call_fn()}. See lifecycle section in \code{\link[=call2]{call2()}} for more about this change. } \examples{ # Extract from a quoted call: call_fn(quote(matrix())) call_fn(quo(matrix())) # Extract the calling function test <- function() call_fn(call_frame()) test() } \seealso{ \code{\link[=call_name]{call_name()}} } rlang/man/seq2.Rd0000644000176200001440000000147613241233650013300 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-utils.R \name{seq2} \alias{seq2} \alias{seq2_along} \title{Increasing sequence of integers in an interval} \usage{ seq2(from, to) seq2_along(from, x) } \arguments{ \item{from}{The starting point of the sequence.} \item{to}{The end point.} \item{x}{A vector whose length is the end point.} } \value{ An integer vector containing a strictly increasing sequence. } \description{ These helpers take two endpoints and return the sequence of all integers within that interval. For \code{seq2_along()}, the upper endpoint is taken from the length of a vector. Unlike \code{base::seq()}, they return an empty vector if the starting point is a larger integer than the end point. } \examples{ seq2(2, 10) seq2(10, 2) seq(10, 2) seq2_along(10, letters) } rlang/man/call_name.Rd0000644000176200001440000000201313241233650014325 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{call_name} \alias{call_name} \title{Extract function name of a call} \usage{ call_name(call) } \arguments{ \item{call}{Can be a call or a quosure that wraps a call.} } \value{ A string with the function name, or \code{NULL} if the function is anonymous. } \description{ Extract function name of a call } \section{Life cycle}{ In rlang 0.2.0, \code{lang_name()} was soft-deprecated and renamed to \code{call_name()}. See lifecycle section in \code{\link[=call2]{call2()}} for more about this change. } \examples{ # Extract the function name from quoted calls: call_name(quote(foo(bar))) call_name(quo(foo(bar))) # Or from a frame: foo <- function(bar) call_name(call_frame()) foo(bar) # Namespaced calls are correctly handled: call_name(~base::matrix(baz)) # Anonymous and subsetted functions return NULL: call_name(quote(foo$bar())) call_name(quote(foo[[bar]]())) call_name(quote(foo()())) } \seealso{ \code{\link[=call_fn]{call_fn()}} } rlang/man/call2.Rd0000644000176200001440000000343613241305652013423 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{call2} \alias{call2} \title{Create a call} \usage{ call2(.fn, ..., .ns = NULL) } \arguments{ \item{.fn}{Function to call. Must be a callable object: a string, symbol, call, or a function.} \item{...}{Arguments to the call either in or out of a list. These dots support \link[=tidy-dots]{tidy dots} features.} \item{.ns}{Namespace with which to prefix \code{.fn}. Must be a string or symbol.} } \description{ Language objects are (with symbols) one of the two types of \link[=is_symbolic]{symbolic} objects in R. These symbolic objects form the backbone of \link[=is_expression]{expressions}. They represent a value, unlike literal objects which are their own values. While symbols are directly \link[=env_bind]{bound} to a value, language objects represent \emph{function calls}, which is why they are commonly referred to as calls. \code{call2()} creates a call from a function name (or a literal function to inline in the call) and a list of arguments. } \section{Life cycle}{ In rlang 0.2.0 \code{lang()} was soft-deprecated and renamed to \code{call2()}. In early versions of rlang calls were called "language" objects in order to follow the R type nomenclature as returned by \code{\link[base:typeof]{base::typeof()}}. The goal was to avoid adding to the confusion between S modes and R types. With hindsight we find it is better to use more meaningful type names. } \examples{ # fn can either be a string, a symbol or a call call2("f", a = 1) call2(quote(f), a = 1) call2(quote(f()), a = 1) #' Can supply arguments individually or in a list call2(quote(f), a = 1, b = 2) call2(quote(f), splice(list(a = 1, b = 2))) # Creating namespaced calls: call2("fun", arg = quote(baz), .ns = "mypkg") } \seealso{ call_modify } rlang/man/abort.Rd0000644000176200001440000000425213241233650013530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd.R \name{abort} \alias{abort} \alias{warn} \alias{inform} \title{Signal an error, warning, or message} \usage{ abort(msg, type = NULL, call = FALSE) warn(msg, type = NULL, call = FALSE) inform(msg, type = NULL, call = FALSE) } \arguments{ \item{msg}{A message to display.} \item{type}{Subclass of the condition to signal.} \item{call}{Whether to display the call. If a number \code{n}, the call is taken from the nth frame on the \link[=call_stack]{call stack}.} } \description{ These functions are equivalent to base functions \code{\link[base:stop]{base::stop()}}, \code{\link[base:warning]{base::warning()}} and \code{\link[base:message]{base::message()}}, but the \code{type} argument makes it easy to create subclassed conditions. They also don't include call information by default. This saves you from typing \code{call. = FALSE} to make error messages cleaner within package functions. } \details{ Like \code{stop()} and \code{\link[=cnd_abort]{cnd_abort()}}, \code{abort()} signals a critical condition and interrupts execution by jumping to top level (see \code{\link[=rst_abort]{rst_abort()}}). Only a handler of the relevant type can prevent this jump by making another jump to a different target on the stack (see \code{\link[=with_handlers]{with_handlers()}}). \code{warn()} and \code{inform()} both have the side effect of displaying a message. These messages will not be displayed if a handler transfers control. Transfer can be achieved by establishing an exiting handler that transfers control to \code{\link[=with_handlers]{with_handlers()}}). In this case, the current function stops and execution resumes at the point where handlers were established. Since it is often desirable to continue normally after a message or warning, both \code{warn()} and \code{inform()} (and their base R equivalent) establish a muffle restart where handlers can jump to prevent the message from being displayed. Execution resumes normally after that. See \code{\link[=rst_muffle]{rst_muffle()}} to jump to a muffling restart, and the \code{muffle} argument of \code{\link[=inplace]{inplace()}} for creating a muffling handler. } rlang/man/quo_expr.Rd0000644000176200001440000000130713241233650014261 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{quo_expr} \alias{quo_expr} \title{Squash a quosure} \usage{ quo_expr(quo, warn = FALSE) } \arguments{ \item{quo}{A quosure or expression.} \item{warn}{Whether to warn if the quosure contains other quosures (those will be collapsed). This is useful when you use \code{quo_squash()} in order to make a non-tidyeval API compatible with quosures. In that case, getting rid of the nested quosures is likely to cause subtle bugs and it is good practice to warn the user about it.} } \description{ This function is soft-deprecated, please use \code{\link[=quo_squash]{quo_squash()}} instead. } \keyword{internal} rlang/man/invoke.Rd0000644000176200001440000000513313241233650013713 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval.R \name{invoke} \alias{invoke} \title{Invoke a function with a list of arguments} \usage{ invoke(.fn, .args = list(), ..., .env = caller_env(), .bury = c(".fn", "")) } \arguments{ \item{.fn}{A function to invoke. Can be a function object or the name of a function in scope of \code{.env}.} \item{.args, ...}{List of arguments (possibly named) to be passed to \code{.fn}.} \item{.env}{The environment in which to call \code{.fn}.} \item{.bury}{A character vector of length 2. The first string specifies which name should the function have in the call recorded in the evaluation stack. The second string specifies a prefix for the argument names. Set \code{.bury} to \code{NULL} if you prefer to inline the function and its arguments in the call.} } \description{ Normally, you invoke a R function by typing arguments manually. A powerful alternative is to call a function with a list of arguments assembled programmatically. This is the purpose of \code{invoke()}. } \details{ Technically, \code{invoke()} is basically a version of \code{\link[base:do.call]{base::do.call()}} that creates cleaner call traces because it does not inline the function and the arguments in the call (see examples). To achieve this, \code{invoke()} creates a child environment of \code{.env} with \code{.fn} and all arguments bound to new symbols (see \code{\link[=env_bury]{env_bury()}}). It then uses the same strategy as \code{\link[=eval_bare]{eval_bare()}} to evaluate with minimal noise. } \section{Life cycle}{ \code{invoke()} is in questioning lifecycle stage. Now that we understand better the interaction between unquoting and dots capture, we believe that \code{invoke()} should not take a \code{.args} argument. Instead it should take dots with \code{\link[=dots_list]{dots_list()}} in order to enable \code{!!!} syntax. We ask rlang users not to use \code{invoke()} in CRAN packages because we plan a breaking API update to remove the \code{.args} argument. } \examples{ # invoke() has the same purpose as do.call(): invoke(paste, letters) # But it creates much cleaner calls: invoke(call_inspect, mtcars) # and stacktraces: fn <- function(...) sys.calls() invoke(fn, list(mtcars)) # Compare to do.call(): do.call(call_inspect, mtcars) do.call(fn, list(mtcars)) # Specify the function name either by supplying a string # identifying the function (it should be visible in .env): invoke("call_inspect", letters) # Or by changing the .bury argument, with which you can also change # the argument prefix: invoke(call_inspect, mtcars, .bury = c("inspect!", "col")) } rlang/man/with_env.Rd0000644000176200001440000000367413241233650014253 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval.R \name{with_env} \alias{with_env} \alias{locally} \title{Evaluate an expression within a given environment} \usage{ with_env(env, expr) locally(expr) } \arguments{ \item{env}{An environment within which to evaluate \code{expr}. Can be an object with an \code{\link[=get_env]{get_env()}} method.} \item{expr}{An expression to evaluate.} } \description{ These functions evaluate \code{expr} within a given environment (\code{env} for \code{with_env()}, or the child of the current environment for \code{locally}). They rely on \code{\link[=eval_bare]{eval_bare()}} which features a lighter evaluation mechanism than base R \code{\link[base:eval]{base::eval()}}, and which also has some subtle implications when evaluting stack sensitive functions (see help for \code{\link[=eval_bare]{eval_bare()}}). } \details{ \code{locally()} is equivalent to the base function \code{\link[base:local]{base::local()}} but it produces a much cleaner evaluation stack, and has stack-consistent semantics. It is thus more suited for experimenting with the R language. } \section{Life cycle}{ These functions are experimental. Expect API changes. } \examples{ # with_env() is handy to create formulas with a given environment: env <- child_env("rlang") f <- with_env(env, ~new_formula()) identical(f_env(f), env) # Or functions with a given enclosure: fn <- with_env(env, function() NULL) identical(get_env(fn), env) # Unlike eval() it doesn't create duplicates on the evaluation # stack. You can thus use it e.g. to create non-local returns: fn <- function() { g(get_env()) "normal return" } g <- function(env) { with_env(env, return("early return")) } fn() # Since env is passed to as_environment(), it can be any object with an # as_environment() method. For strings, the pkg_env() is returned: with_env("base", ~mtcars) # This can be handy to put dictionaries in scope: with_env(mtcars, cyl) } rlang/man/call_inspect.Rd0000644000176200001440000000125613241233650015062 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{call_inspect} \alias{call_inspect} \title{Inspect a call} \usage{ call_inspect(...) } \arguments{ \item{...}{Arguments to display in the returned call.} } \description{ This function is useful for quick testing and debugging when you manipulate expressions and calls. It lets you check that a function is called with the right arguments. This can be useful in unit tests for instance. Note that this is just a simple wrapper around \code{\link[base:match.call]{base::match.call()}}. } \examples{ call_inspect(foo(bar), "" \%>\% identity()) invoke(call_inspect, list(a = mtcars, b = letters)) } rlang/man/is_empty.Rd0000644000176200001440000000052413241233650014250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{is_empty} \alias{is_empty} \title{Is object an empty vector or NULL?} \usage{ is_empty(x) } \arguments{ \item{x}{object to test} } \description{ Is object an empty vector or NULL? } \examples{ is_empty(NULL) is_empty(list()) is_empty(list(NULL)) } rlang/man/env_has.Rd0000644000176200001440000000204513241233650014042 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_has} \alias{env_has} \title{Does an environment have or see bindings?} \usage{ env_has(env = caller_env(), nms, inherit = FALSE) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{nms}{A character vector containing the names of the bindings to remove.} \item{inherit}{Whether to look for bindings in the parent environments.} } \value{ A logical vector as long as \code{nms}. } \description{ \code{env_has()} is a vectorised predicate that queries whether an environment owns bindings personally (with \code{inherit} set to \code{FALSE}, the default), or sees them in its own environment or in any of its parents (with \code{inherit = TRUE}). } \examples{ parent <- child_env(NULL, foo = "foo") env <- child_env(parent, bar = "bar") # env does not own `foo` but sees it in its parent environment: env_has(env, "foo") env_has(env, "foo", inherit = TRUE) } rlang/man/stack.Rd0000644000176200001440000001207013241233650013523 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{stack} \alias{stack} \alias{global_frame} \alias{current_frame} \alias{ctxt_frame} \alias{call_frame} \alias{ctxt_depth} \alias{call_depth} \alias{ctxt_stack} \alias{call_stack} \title{Call stack information} \usage{ global_frame() current_frame() ctxt_frame(n = 1) call_frame(n = 1, clean = TRUE) ctxt_depth() call_depth() ctxt_stack(n = NULL, trim = 0) call_stack(n = NULL, clean = TRUE) } \arguments{ \item{n}{The number of frames to go back in the stack.} \item{clean}{Whether to post-process the call stack to clean non-standard frames. If \code{TRUE}, suboptimal call-stack entries by \code{\link[base:eval]{base::eval()}} will be cleaned up: the duplicate frame created by \code{eval()} is eliminated.} \item{trim}{The number of layers of intervening frames to trim off the stack. See \code{\link[=stack_trim]{stack_trim()}} and examples.} } \description{ The \code{eval_} and \code{call_} families of functions provide a replacement for the base R functions prefixed with \code{sys.} (which are all about the context stack), as well as for \code{\link[=parent.frame]{parent.frame()}} (which is the only base R function for querying the call stack). The context stack includes all R-level evaluation contexts. It is linear in terms of execution history but due to lazy evaluation it is potentially nonlinear in terms of call history. The call stack history, on the other hand, is homogenous. } \details{ \code{ctxt_frame()} and \code{call_frame()} return a \code{frame} object containing the following fields: \code{expr} and \code{env} (call expression and evaluation environment), \code{pos} and \code{caller_pos} (position of current frame in the context stack and position of the caller), and \code{fun} (function of the current frame). \code{ctxt_stack()} and \code{call_stack()} return a list of all context or call frames on the stack. Finally, \code{ctxt_depth()} and \code{call_depth()} report the current context position or the number of calling frames on the stack. The base R functions take two sorts of arguments to indicate which frame to query: \code{which} and \code{n}. The \code{n} argument is straightforward: it's the number of frames to go down the stack, with \code{n = 1} referring to the current context. The \code{which} argument is more complicated and changes meaning for values lower than 1. For the sake of consistency, the lazyeval functions all take the same kind of argument \code{n}. This argument has a single meaning (the number of frames to go down the stack) and cannot be lower than 1. Note finally that \code{parent.frame(1)} corresponds to \code{call_frame(2)$env}, as \code{n = 1} always refers to the current frame. This makes the \code{_frame()} and \code{_stack()} functions consistent: \code{ctxt_frame(2)} is the same as \code{ctxt_stack()[[2]]}. Also, \code{ctxt_depth()} returns one more frame than [base::sys.nframe()] because it counts the global frame. That is consistent with the \code{_stack()} functions which return the global frame as well. This way, \code{call_stack(call_depth())} is the same as \code{global_frame()}. [[2]: R:[2 [base::sys.nframe()]: R:base::sys.nframe() } \section{Life cycle}{ These functions are in the questioning stage. We are no longer convinced they belong in rlang as they are mostly for REPL interaction and runtime inspection rather than function development. } \examples{ # Expressions within arguments count as contexts identity(identity(ctxt_depth())) # returns 2 # But they are not part of the call stack because arguments are # evaluated within the calling function (or the global environment # if called at top level) identity(identity(call_depth())) # returns 0 # The context stacks includes all intervening execution frames. The # call stack doesn't: f <- function(x) identity(x) f(f(ctxt_stack())) f(f(call_stack())) g <- function(cmd) cmd() f(g(ctxt_stack)) f(g(call_stack)) # The lazyeval _stack() functions return a list of frame # objects. Use purrr::transpose() or index a field with # purrr::map()'s to extract a particular field from a stack: # stack <- f(f(call_stack())) # purrr::map(stack, "env") # purrr::transpose(stack)$expr # current_frame() is an alias for ctxt_frame(1) fn <- function() list(current = current_frame(), first = ctxt_frame(1)) fn() # While current_frame() is the top of the stack, global_frame() is # the bottom: fn <- function() { n <- ctxt_depth() ctxt_frame(n) } identical(fn(), global_frame()) # ctxt_stack() returns a stack with all intervening frames. You can # trim layers of intervening frames with the trim argument: identity(identity(ctxt_stack())) identity(identity(ctxt_stack(trim = 1))) # ctxt_stack() is called within fn() with intervening frames: fn <- function(trim) identity(identity(ctxt_stack(trim = trim))) fn(0) # We can trim the first layer of those: fn(1) # The outside intervening frames (at the fn() call site) are still # returned, but can be trimmed as well: identity(identity(fn(1))) identity(identity(fn(2))) g <- function(trim) identity(identity(fn(trim))) g(2) g(3) } \keyword{internal} rlang/man/env_bind_exprs.Rd0000644000176200001440000000331513241305652015427 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_bind_exprs} \alias{env_bind_exprs} \alias{env_bind_fns} \title{Bind lazy or active bindings} \usage{ env_bind_exprs(.env, ..., .eval_env = caller_env()) env_bind_fns(.env, ...) } \arguments{ \item{.env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}. This argument is passed to \code{\link[=get_env]{get_env()}}.} \item{...}{Pairs of names and expressions, values or functions. These dots support \link[=tidy-dots]{tidy dots} features.} \item{.eval_env}{The environment where the expressions will be evaluated when the symbols are forced.} } \description{ Bind lazy or active bindings } \section{Life cycle}{ These functions are experimental. Expect API changes. } \examples{ # env_bind_exprs() assigns expressions lazily: env <- env() env_bind_exprs(env, name = cat("forced!\\n")) env$name env$name # You can unquote expressions. Note that quosures are not # supported, only raw expressions: expr <- quote(message("forced!")) env_bind_exprs(env, name = !! expr) env$name # You can create active bindings with env_bind_fns() # Let's create some bindings in the lexical enclosure of `fn`: counter <- 0 # And now a function that increments the counter and returns a # string with the count: fn <- function() { counter <<- counter + 1 paste("my counter:", counter) } # Now we create an active binding in a child of the current # environment: env <- env() env_bind_fns(env, symbol = fn) # `fn` is executed each time `symbol` is evaluated or retrieved: env$symbol env$symbol eval_bare(quote(symbol), env) eval_bare(quote(symbol), env) } \keyword{internal} rlang/man/rst_list.Rd0000644000176200001440000000202513241305652014262 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd-restarts.R \name{rst_list} \alias{rst_list} \alias{rst_exists} \alias{rst_jump} \alias{rst_maybe_jump} \title{Restarts utilities} \usage{ rst_list() rst_exists(.restart) rst_jump(.restart, ...) rst_maybe_jump(.restart, ...) } \arguments{ \item{.restart}{The name of a restart.} \item{...}{Arguments passed on to the restart function. These dots support \link[=tidy-dots]{tidy dots} features.} } \description{ Restarts are named jumping points established by \code{\link[=with_restarts]{with_restarts()}}. \code{rst_list()} returns the names of all restarts currently established. \code{rst_exists()} checks if a given restart is established. \code{rst_jump()} stops execution of the current function and jumps to a restart point. If the restart does not exist, an error is thrown. \code{rst_maybe_jump()} first checks that a restart exists before jumping. } \seealso{ \code{\link[=with_restarts]{with_restarts()}}, \code{\link[=rst_muffle]{rst_muffle()}}. } rlang/man/switch_lang.Rd0000644000176200001440000000625413241233650014727 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{switch_lang} \alias{switch_lang} \alias{coerce_lang} \alias{lang_type_of} \title{Dispatch on call type} \usage{ switch_lang(.x, ...) coerce_lang(.x, .to, ...) lang_type_of(x) } \arguments{ \item{.x, x}{A language object (a call). If a formula quote, the RHS is extracted first.} \item{...}{Named clauses. The names should be types as returned by \code{lang_type_of()}.} \item{.to}{This is useful when you switchpatch within a coercing function. If supplied, this should be a string indicating the target type. A catch-all clause is then added to signal an error stating the conversion failure. This type is prettified unless \code{.to} inherits from the S3 class \code{"AsIs"} (see \code{\link[base:I]{base::I()}}).} } \description{ \code{switch_lang()} dispatches clauses based on the subtype of call, as determined by \code{lang_type_of()}. The subtypes are based on the type of call head (see details). } \details{ Calls (objects of type \code{language}) do not necessarily call a named function. They can also call an anonymous function or the result of some other expression. The language subtypes are organised around the kind of object being called: \itemize{ \item For regular calls to named function, \code{switch_lang()} returns "named". \item Sometimes the function being called is the result of another function call, e.g. \code{foo()()}, or the result of another subsetting call, e.g. \code{foo$bar()} or \code{foo@bar()}. In this case, the call head is not a symbol, it is another call (e.g. to the infix functions \code{$} or \code{@}). The call subtype is said to be "recursive". \item A special subset of recursive calls are namespaced calls like \code{foo::bar()}. \code{switch_lang()} returns "namespaced" for these calls. It is generally a good idea if your function treats \code{bar()} and \code{foo::bar()} similarly. \item Finally, it is possible to have a literal (see \code{\link[=is_expression]{is_expression()}} for a definition of literals) as call head. In most cases, this will be a function inlined in the call (this is sometimes an expedient way of dealing with scoping issues). For calls with a literal node head, \code{switch_lang()} returns "inlined". Note that if a call head contains a literal that is not function, something went wrong and using that object will probably make R crash. \code{switch_lang()} issues an error in this case. } The reason we use the term \emph{node head} is because calls are structured as tree objects. This makes sense because the best representation for language code is a tree whose hierarchy is determined by the order of operations. See \link{node} for more on this. } \section{Life cycle}{ \itemize{ \item \code{lang_type_of()} is an experimental function. \item \code{switch_lang()} and \code{coerce_lang()} are experimental functions. } } \examples{ # Named calls: lang_type_of(~foo()) # Recursive calls: lang_type_of(~foo$bar()) lang_type_of(~foo()()) # Namespaced calls: lang_type_of(~base::list()) # For an inlined call, let's inline a function in the head node: call <- quote(foo(letters)) call[[1]] <- base::toupper call lang_type_of(call) } \keyword{internal} rlang/man/set_attrs.Rd0000644000176200001440000000366013241304332014427 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attr.R \name{set_attrs} \alias{set_attrs} \alias{mut_attrs} \title{Add attributes to an object} \usage{ set_attrs(.x, ...) mut_attrs(.x, ...) } \arguments{ \item{.x}{An object to decorate with attributes.} \item{...}{A list of named attributes. These have \link[=tidy-dots]{explicit splicing semantics}. Pass a single unnamed \code{NULL} to zap all attributes from \code{.x}.} } \value{ \code{set_attrs()} returns a modified \link[=duplicate]{shallow copy} of \code{.x}. \code{mut_attrs()} invisibly returns the original \code{.x} modified in place. } \description{ \code{set_attrs()} adds, changes, or zaps attributes of objects. Pass a single unnamed \code{NULL} as argument to zap all attributes. For \link[=is_copyable]{uncopyable} types, use \code{mut_attrs()}. } \details{ Unlike \code{\link[=structure]{structure()}}, these setters have no special handling of internal attributes names like \code{.Dim}, \code{.Dimnames} or \code{.Names}. } \section{Life cycle}{ These functions are experimental, expect API changes. \itemize{ \item \code{set_attrs()} should probably set the attributes as a whole. Another function with \code{add_} prefix would be in charge of adding an attribute to the set. \item \code{mut_attrs()} should be renamed to use the \code{poke_} prefix. Also it may be useful to allow any kind of objects, not just \link[=is_copyable]{non-copyable} ones. } } \examples{ set_attrs(letters, names = 1:26, class = "my_chr") # Splice a list of attributes: attrs <- list(attr = "attr", names = 1:26, class = "my_chr") obj <- set_attrs(letters, splice(attrs)) obj # Zap attributes by passing a single unnamed NULL argument: set_attrs(obj, NULL) set_attrs(obj, !!! list(NULL)) # Note that set_attrs() never modifies objects in place: obj # For uncopyable types, mut_attrs() lets you modify in place: env <- env() mut_attrs(env, foo = "bar") env } \keyword{internal} rlang/man/mut_utf8_locale.Rd0000644000176200001440000000376513241233650015523 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-chr.R \name{mut_utf8_locale} \alias{mut_utf8_locale} \alias{mut_latin1_locale} \alias{mut_mbcs_locale} \title{Set the locale's codeset for testing} \usage{ mut_utf8_locale() mut_latin1_locale() mut_mbcs_locale() } \value{ The previous locale (invisibly). } \description{ Setting a locale's codeset (specifically, the \code{LC_CTYPE} category) produces side effects in R's handling of strings. The most important of these affects how the R parser marks strings. R has specific internal support for latin1 (single-byte encoding) and UTF-8 (multi-bytes variable-width encoding) strings. If the locale codeset is latin1 or UTF-8, the parser will mark all strings with the corresponding encoding. It is important for strings to have consistent encoding markers, as they determine a number of internal encoding conversions when R or packages handle strings (see \code{\link[=set_str_encoding]{set_str_encoding()}} for some examples). } \details{ If you are changing the locale encoding for testing purposes, you need to be aware that R caches strings and symbols to save memory. If you change the locale during an R session, it can lead to surprising and difficult to reproduce results. In doubt, restart your R session. Note that these helpers are only provided for testing interactively the effects of changing locale codeset. They let you quickly change the default text encoding to latin1, UTF-8, or non-UTF-8 MBCS. They are not widely tested and do not provide a way of setting the language and region of the locale. They have permanent side effects and should probably not be used in package examples, unit tests, or in the course of a data analysis. Note finally that \code{mut_utf8_locale()} will not work on Windows as only latin1 and MBCS locales are supported on this OS. } \section{Life cycle}{ These functions are experimental. They might be removed in the future because they don't bring anything new over the base API. } \keyword{internal} rlang/man/env_get.Rd0000644000176200001440000000220413241233650014043 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_get} \alias{env_get} \alias{env_get_list} \title{Get an object in an environment} \usage{ env_get(env = caller_env(), nm, inherit = FALSE) env_get_list(env = caller_env(), nms, inherit = FALSE) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{nm, nms}{Names of bindings. \code{nm} must be a single string.} \item{inherit}{Whether to look for bindings in the parent environments.} } \value{ An object if it exists. Otherwise, throws an error. } \description{ \code{env_get()} extracts an object from an enviroment \code{env}. By default, it does not look in the parent environments. \code{env_get_list()} extracts multiple objects from an environment into a named list. } \examples{ parent <- child_env(NULL, foo = "foo") env <- child_env(parent, bar = "bar") # This throws an error because `foo` is not directly defined in env: # env_get(env, "foo") # However `foo` can be fetched in the parent environment: env_get(env, "foo", inherit = TRUE) } rlang/man/is_pairlist.Rd0000644000176200001440000000171013241233650014737 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/node.R \name{is_pairlist} \alias{is_pairlist} \alias{is_node} \alias{is_node_list} \title{Is object a node or pairlist?} \usage{ is_pairlist(x) is_node(x) is_node_list(x) } \arguments{ \item{x}{Object to test.} } \description{ \itemize{ \item \code{is_pairlist()} checks that \code{x} has type \code{pairlist}. \item \code{is_node()} checks that \code{x} has type \code{pairlist} or \code{language}. It tests whether \code{x} is a node that has a CAR and a CDR, including callable nodes (language objects). \item \code{is_node_list()} checks that \code{x} has type \code{pairlist} or \code{NULL}. \code{NULL} is the empty node list. } } \section{Life cycle}{ These functions are experimental. We are still figuring out a good naming convention to refer to the different lisp-like lists in R. } \seealso{ \code{\link[=is_call]{is_call()}} tests for language nodes. } \keyword{internal} rlang/man/cnd_signal.Rd0000644000176200001440000001340513241304332014516 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd.R \name{cnd_signal} \alias{cnd_signal} \alias{cnd_inform} \alias{cnd_warn} \alias{cnd_abort} \title{Signal a condition} \usage{ cnd_signal(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = TRUE) cnd_inform(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = FALSE) cnd_warn(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = FALSE) cnd_abort(.cnd, ..., .msg = NULL, .call = NULL, .mufflable = FALSE) } \arguments{ \item{.cnd}{Either a condition object (see \code{\link[=cnd]{cnd()}}), or the name of a s3 class from which a new condition will be created.} \item{...}{Named data fields stored inside the condition object. These dots are evaluated with \link[=tidy-dots]{explicit splicing}.} \item{.msg}{A string to override the condition's default message.} \item{.call}{Whether to display the call of the frame in which the condition is signalled. If \code{TRUE}, the call is stored in the \code{call} field of the condition object: this field is displayed by R when an error is issued. If a number \code{n}, the call is taken from the nth frame on the \link[=call_stack]{call stack}. If \code{NULL}, the call is taken from the \code{.call} field that was supplied to the condition constructor (e.g. \code{\link[=cnd]{cnd()}}). In all cases the \code{.call} field is updated with the actual call.} \item{.mufflable}{Whether to signal the condition with a muffling restart. This is useful to let \code{\link[=inplace]{inplace()}} handlers muffle a condition. It stops the condition from being passed to other handlers when the inplace handler did not jump elsewhere. \code{TRUE} by default for benign conditions, but \code{FALSE} for critical ones, since in those cases execution should probably not be allowed to continue normally.} } \description{ Signal a condition to handlers that have been established on the stack. Conditions signalled with \code{cnd_signal()} are assumed to be benign. Control flow can resume normally once the conditions has been signalled (if no handler jumped somewhere else on the evaluation stack). On the other hand, \code{cnd_abort()} treats the condition as critical and will jump out of the distressed call frame (see \code{\link[=rst_abort]{rst_abort()}}), unless a handler can deal with the condition. } \details{ If \code{.critical} is \code{FALSE}, this function has no side effects beyond calling handlers. In particular, execution will continue normally after signalling the condition (unless a handler jumped somewhere else via \code{\link[=rst_jump]{rst_jump()}} or by being \code{\link[=exiting]{exiting()}}). If \code{.critical} is \code{TRUE}, the condition is signalled via \code{\link[base:stop]{base::stop()}} and the program will terminate if no handler dealt with the condition by jumping out of the distressed call frame. \code{\link[=inplace]{inplace()}} handlers are called in turn when they decline to handle the condition by returning normally. However, it is sometimes useful for an inplace handler to produce a side effect (signalling another condition, displaying a message, logging something, etc), prevent the condition from being passed to other handlers, and resume execution from the place where the condition was signalled. The easiest way to accomplish this is by jumping to a restart point (see \code{\link[=with_restarts]{with_restarts()}}) established by the signalling function. If \code{.mufflable} is \code{TRUE}, a muffle restart is established. This allows inplace handler to muffle a signalled condition. See \code{\link[=rst_muffle]{rst_muffle()}} to jump to a muffling restart, and the \code{muffle} argument of \code{\link[=inplace]{inplace()}} for creating a muffling handler. } \examples{ # Creating a condition of type "foo" cnd <- cnd("foo") # If no handler capable of dealing with "foo" is established on the # stack, signalling the condition has no effect: cnd_signal(cnd) # To learn more about establishing condition handlers, see # documentation for with_handlers(), exiting() and inplace(): with_handlers(cnd_signal(cnd), foo = inplace(function(c) cat("side effect!\\n")) ) # By default, cnd_signal() creates a muffling restart which allows # inplace handlers to prevent a condition from being passed on to # other handlers and to resume execution: undesirable_handler <- inplace(function(c) cat("please don't call me\\n")) muffling_handler <- inplace(function(c) { cat("muffling foo...\\n") rst_muffle(c) }) with_handlers(foo = undesirable_handler, with_handlers(foo = muffling_handler, { cnd_signal("foo") "return value" })) # cnd_warn() and cnd_inform() signal a condition and display a # warning or message: \dontrun{ cnd_inform(cnd) cnd_warn(cnd) } # You can signal a critical condition with cnd_abort(). Unlike # cnd_signal() which has no side effect besides signalling the # condition, cnd_abort() makes the program terminate with an error # unless a handler can deal with the condition: \dontrun{ cnd_abort(cnd) } # If you don't specify a .msg or .call, the default message/call # (supplied to cnd()) are displayed. Otherwise, the ones # supplied to cnd_abort() and cnd_signal() take precedence: \dontrun{ critical <- cnd("my_error", .msg = "default 'my_error' msg", .call = quote(default(call)) ) cnd_abort(critical) cnd_abort(critical, .msg = "overridden msg") fn <- function(...) { cnd_abort(critical, .call = TRUE) } fn(arg = foo(bar)) } # Note that by default a condition signalled with cnd_abort() does # not have a muffle restart. That is because in most cases, # execution should not continue after signalling a critical # condition. } \seealso{ \code{\link[=abort]{abort()}}, \code{\link[=warn]{warn()}} and \code{\link[=inform]{inform()}} for signalling typical R conditions. See \code{\link[=with_handlers]{with_handlers()}} for establishing condition handlers. } rlang/man/as_utf8_character.Rd0000644000176200001440000000402713241233650016006 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-chr.R \name{as_utf8_character} \alias{as_utf8_character} \alias{as_native_character} \alias{as_utf8_string} \alias{as_native_string} \title{Coerce to a character vector and attempt encoding conversion} \usage{ as_utf8_character(x) as_native_character(x) as_utf8_string(x) as_native_string(x) } \arguments{ \item{x}{An object to coerce.} } \description{ Unlike specifying the \code{encoding} argument in \code{as_string()} and \code{as_character()}, which is only declarative, these functions actually attempt to convert the encoding of their input. There are two possible cases: \itemize{ \item The string is tagged as UTF-8 or latin1, the only two encodings for which R has specific support. In this case, converting to the same encoding is a no-op, and converting to native always works as expected, as long as the native encoding, the one specified by the \code{LC_CTYPE} locale (see \code{\link[=mut_utf8_locale]{mut_utf8_locale()}}) has support for all characters occurring in the strings. Unrepresentable characters are serialised as unicode points: "". \item The string is not tagged. R assumes that it is encoded in the native encoding. Conversion to native is a no-op, and conversion to UTF-8 should work as long as the string is actually encoded in the locale codeset. } When translating to UTF-8, the strings are parsed for serialised unicode points (e.g. strings looking like "U+xxxx") with \code{\link[=chr_unserialise_unicode]{chr_unserialise_unicode()}}. This helps to alleviate the effects of character-to-symbol-to-character roundtrips on systems with non-UTF-8 native encoding. } \examples{ # Let's create a string marked as UTF-8 (which is guaranteed by the # Unicode escaping in the string): utf8 <- "caf\\uE9" str_encoding(utf8) as_bytes(utf8) # It can then be converted to a native encoding, that is, the # encoding specified in the current locale: \dontrun{ mut_latin1_locale() latin1 <- as_native_string(utf8) str_encoding(latin1) as_bytes(latin1) } } rlang/man/flatten.Rd0000644000176200001440000000507313241233650014060 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-squash.R \name{flatten} \alias{flatten} \alias{flatten_lgl} \alias{flatten_int} \alias{flatten_dbl} \alias{flatten_cpl} \alias{flatten_chr} \alias{flatten_raw} \alias{squash} \alias{squash_lgl} \alias{squash_int} \alias{squash_dbl} \alias{squash_cpl} \alias{squash_chr} \alias{squash_raw} \alias{flatten_if} \alias{squash_if} \title{Flatten or squash a list of lists into a simpler vector} \usage{ flatten(x) flatten_lgl(x) flatten_int(x) flatten_dbl(x) flatten_cpl(x) flatten_chr(x) flatten_raw(x) squash(x) squash_lgl(x) squash_int(x) squash_dbl(x) squash_cpl(x) squash_chr(x) squash_raw(x) flatten_if(x, predicate = is_spliced) squash_if(x, predicate = is_spliced) } \arguments{ \item{x}{A list of flatten or squash. The contents of the list can be anything for unsuffixed functions \code{flatten()} and \code{squash()} (as a list is returned), but the contents must match the type for the other functions.} \item{predicate}{A function of one argument returning whether it should be spliced.} } \value{ \code{flatten()} returns a list, \code{flatten_lgl()} a logical vector, \code{flatten_int()} an integer vector, \code{flatten_dbl()} a double vector, and \code{flatten_chr()} a character vector. Similarly for \code{squash()} and the typed variants (\code{squash_lgl()} etc). } \description{ \code{flatten()} removes one level hierarchy from a list, while \code{squash()} removes all levels. These functions are similar to \code{\link[=unlist]{unlist()}} but they are type-stable so you always know what the type of the output is. } \examples{ x <- replicate(2, sample(4), simplify = FALSE) x flatten(x) flatten_int(x) # With flatten(), only one level gets removed at a time: deep <- list(1, list(2, list(3))) flatten(deep) flatten(flatten(deep)) # But squash() removes all levels: squash(deep) squash_dbl(deep) # The typed flattens remove one level and coerce to an atomic # vector at the same time: flatten_dbl(list(1, list(2))) # Only bare lists are flattened, but you can splice S3 lists # explicitly: foo <- set_attrs(list("bar"), class = "foo") str(flatten(list(1, foo, list(100)))) str(flatten(list(1, splice(foo), list(100)))) # Instead of splicing manually, flatten_if() and squash_if() let # you specify a predicate function: is_foo <- function(x) inherits(x, "foo") || is_bare_list(x) str(flatten_if(list(1, foo, list(100)), is_foo)) # squash_if() does the same with deep lists: deep_foo <- list(1, list(foo, list(foo, 100))) str(deep_foo) str(squash(deep_foo)) str(squash_if(deep_foo, is_foo)) } rlang/man/env_clone.Rd0000644000176200001440000000117113241233650014366 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_clone} \alias{env_clone} \title{Clone an environment} \usage{ env_clone(env, parent = env_parent(env)) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{parent}{The parent of the cloned environment.} } \description{ This creates a new environment containing exactly the same objects, optionally with a new parent. } \examples{ env <- env(!!! mtcars) clone <- env_clone(env) identical(env, clone) identical(env$cyl, clone$cyl) } rlang/man/is_expr.Rd0000644000176200001440000000070513241233650014071 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{is_expr} \alias{is_expr} \title{Is an object an expression?} \usage{ is_expr(x) } \arguments{ \item{x}{An object to test.} } \description{ This function was soft-deprecated and renamed to \code{\link[=is_expression]{is_expression()}} in rlang 0.2.0. This is for consistency with other type predicates which are not abbreviated. } \keyword{internal} rlang/man/is_expression.Rd0000644000176200001440000000775513241233650015326 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/expr.R \name{is_expression} \alias{is_expression} \alias{is_syntactic_literal} \alias{is_symbolic} \title{Is an object an expression?} \usage{ is_expression(x) is_syntactic_literal(x) is_symbolic(x) } \arguments{ \item{x}{An object to test.} } \description{ \code{is_expression()} tests for expressions, the set of objects that can be obtained from parsing R code. An expression can be one of two things: either a symbolic object (for which \code{is_symbolic()} returns \code{TRUE}), or a syntactic literal (testable with \code{is_syntactic_literal()}). Technically, calls can contain any R object, not necessarily symbolic objects or syntactic literals. However, this only happens in artificial situations. Expressions as we define them only contain numbers, strings, \code{NULL}, symbols, and calls: this is the complete set of R objects that can be created when R parses source code (e.g. from using \code{\link[=parse_expr]{parse_expr()}}). Note that we are using the term expression in its colloquial sense and not to refer to \code{\link[=expression]{expression()}} vectors, a data type that wraps expressions in a vector and which isn't used much in modern R code. } \details{ \code{is_symbolic()} returns \code{TRUE} for symbols and calls (objects with type \code{language}). Symbolic objects are replaced by their value during evaluation. Literals are the complement of symbolic objects. They are their own value and return themselves during evaluation. \code{is_syntactic_literal()} is a predicate that returns \code{TRUE} for the subset of literals that are created by R when parsing text (see \code{\link[=parse_expr]{parse_expr()}}): numbers, strings and \code{NULL}. Along with symbols, these literals are the terminating nodes in an AST. Note that in the most general sense, a literal is any R object that evaluates to itself and that can be evaluated in the empty environment. For instance, \code{quote(c(1, 2))} is not a literal, it is a call. However, the result of evaluating it in \code{\link[=base_env]{base_env()}} is a literal(in this case an atomic vector). Pairlists are also a kind of language objects. However, since they are mostly an internal data structure, \code{is_expression()} returns \code{FALSE} for pairlists. You can use \code{is_pairlist()} to explicitly check for them. Pairlists are the data structure for function arguments. They usually do not arise from R code because subsetting a call is a type-preserving operation. However, you can obtain the pairlist of arguments by taking the CDR of the call object from C code. The rlang function \code{\link[=node_cdr]{node_cdr()}} will do it from R. Another way in which pairlist of arguments arise is by extracting the argument list of a closure with \code{\link[base:formals]{base::formals()}} or \code{\link[=fn_fmls]{fn_fmls()}}. } \examples{ q1 <- quote(1) is_expression(q1) is_syntactic_literal(q1) q2 <- quote(x) is_expression(q2) is_symbol(q2) q3 <- quote(x + 1) is_expression(q3) is_call(q3) # Atomic expressions are the terminating nodes of a call tree: # NULL or a scalar atomic vector: is_syntactic_literal("string") is_syntactic_literal(NULL) is_syntactic_literal(letters) is_syntactic_literal(quote(call())) # Parsable literals have the property of being self-quoting: identical("foo", quote("foo")) identical(1L, quote(1L)) identical(NULL, quote(NULL)) # Like any literals, they can be evaluated within the empty # environment: eval_bare(quote(1L), empty_env()) # Whereas it would fail for symbolic expressions: # eval_bare(quote(c(1L, 2L)), empty_env()) # Pairlists are also language objects representing argument lists. # You will usually encounter them with extracted formals: fmls <- formals(is_expression) typeof(fmls) # Since they are mostly an internal data structure, is_expression() # returns FALSE for pairlists, so you will have to check explicitly # for them: is_expression(fmls) is_pairlist(fmls) } \seealso{ \code{\link[=is_call]{is_call()}} for a call predicate. } rlang/man/tidyeval-data.Rd0000644000176200001440000000200313241233650015141 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval-tidy.R \docType{data} \name{tidyeval-data} \alias{tidyeval-data} \alias{.data} \title{Data pronoun for tidy evaluation} \format{An object of class \code{rlang_data_pronoun} of length 0.} \usage{ .data } \description{ This pronoun allows you to be explicit when you refer to an object inside the data. Referring to the \code{.data} pronoun rather than to the original data frame has several advantages: \itemize{ \item Sometimes a computation is not about the whole data but about a subset. For example if you supply a grouped data frame to a dplyr verb, the \code{.data} pronoun contains the group subset. \item It lets dplyr know that you're referring to a column from the data which is helpful to generate correct queries when the source is a database. } The \code{.data} object exported here is useful to import in your package namespace to avoid a \code{R CMD check} note when referring to objects from the data mask. } \keyword{datasets} rlang/man/string.Rd0000644000176200001440000000267713241233650013740 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-chr.R \name{string} \alias{string} \title{Create a string} \usage{ string(x, encoding = NULL) } \arguments{ \item{x}{A character vector or a vector or list of string-like objects.} \item{encoding}{If non-null, passed to \code{\link[=set_chr_encoding]{set_chr_encoding()}} to add an encoding mark. This is only declarative, no encoding conversion is performed.} } \description{ These base-type constructors allow more control over the creation of strings in R. They take character vectors or string-like objects (integerish or raw vectors), and optionally set the encoding. The string version checks that the input contains a scalar string. } \examples{ # As everywhere in R, you can specify a string with Unicode # escapes. The characters corresponding to Unicode codepoints will # be encoded in UTF-8, and the string will be marked as UTF-8 # automatically: cafe <- string("caf\\uE9") str_encoding(cafe) as_bytes(cafe) # In addition, string() provides useful conversions to let # programmers control how the string is represented in memory. For # encodings other than UTF-8, you'll need to supply the bytes in # hexadecimal form. If it is a latin1 encoding, you can mark the # string explicitly: cafe_latin1 <- string(c(0x63, 0x61, 0x66, 0xE9), "latin1") str_encoding(cafe_latin1) as_bytes(cafe_latin1) } \seealso{ \code{set_chr_encoding()} for more information about encodings in R. } rlang/man/mut_node_car.Rd0000644000176200001440000000204113241233650015052 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{mut_node_car} \alias{mut_node_car} \alias{mut_node_cdr} \alias{mut_node_caar} \alias{mut_node_cadr} \alias{mut_node_cdar} \alias{mut_node_cddr} \alias{mut_node_tag} \title{Mutate node components} \usage{ mut_node_car(x, newcar) mut_node_cdr(x, newcdr) mut_node_caar(x, newcar) mut_node_cadr(x, newcar) mut_node_cdar(x, newcdr) mut_node_cddr(x, newcdr) mut_node_tag(x, newtag) } \arguments{ \item{x}{A language or pairlist node. Note that these functions are barebones and do not perform any type checking.} \item{newcar}{The new CAR or CDR for the node. These can be any R objects.} \item{newcdr}{The new CAR or CDR for the node. These can be any R objects.} \item{newtag}{The new tag for the node. This should be a symbol.} } \description{ These functions were soft-deprecated and renamed with \code{node_poke_} prefix in rlang 0.2.0. This change follows a new naming convention where mutation is referred to as "poking". } \keyword{internal} rlang/man/env_unbind.Rd0000644000176200001440000000250213241233650014544 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_unbind} \alias{env_unbind} \title{Remove bindings from an environment} \usage{ env_unbind(env = caller_env(), nms, inherit = FALSE) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{nms}{A character vector containing the names of the bindings to remove.} \item{inherit}{Whether to look for bindings in the parent environments.} } \value{ The input object \code{env} with its associated environment modified in place, invisibly. } \description{ \code{env_unbind()} is the complement of \code{\link[=env_bind]{env_bind()}}. Like \code{env_has()}, it ignores the parent environments of \code{env} by default. Set \code{inherit} to \code{TRUE} to track down bindings in parent environments. } \examples{ data <- set_names(as_list(letters), letters) env_bind(environment(), !!! data) env_has(environment(), letters) # env_unbind() removes bindings: env_unbind(environment(), letters) env_has(environment(), letters) # With inherit = TRUE, it removes bindings in parent environments # as well: parent <- child_env(NULL, foo = "a") env <- child_env(parent, foo = "b") env_unbind(env, "foo", inherit = TRUE) env_has(env, "foo", inherit = TRUE) } rlang/man/bare-type-predicates.Rd0000644000176200001440000000316213241233650016431 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{bare-type-predicates} \alias{bare-type-predicates} \alias{is_bare_list} \alias{is_bare_atomic} \alias{is_bare_vector} \alias{is_bare_double} \alias{is_bare_integer} \alias{is_bare_numeric} \alias{is_bare_character} \alias{is_bare_logical} \alias{is_bare_raw} \alias{is_bare_string} \alias{is_bare_bytes} \title{Bare type predicates} \usage{ is_bare_list(x, n = NULL) is_bare_atomic(x, n = NULL) is_bare_vector(x, n = NULL) is_bare_double(x, n = NULL) is_bare_integer(x, n = NULL) is_bare_numeric(x, n = NULL) is_bare_character(x, n = NULL, encoding = NULL) is_bare_logical(x, n = NULL) is_bare_raw(x, n = NULL) is_bare_string(x, n = NULL) is_bare_bytes(x, n = NULL) } \arguments{ \item{x}{Object to be tested.} \item{n}{Expected length of a vector.} \item{encoding}{Expected encoding of a string or character vector. One of \code{UTF-8}, \code{latin1}, or \code{unknown}.} } \description{ These predicates check for a given type but only return \code{TRUE} for bare R objects. Bare objects have no class attributes. For example, a data frame is a list, but not a bare list. } \details{ \itemize{ \item The predicates for vectors include the \code{n} argument for pattern-matching on the vector length. \item Like \code{\link[=is_atomic]{is_atomic()}} and unlike base R \code{is.atomic()}, \code{is_bare_atomic()} does not return \code{TRUE} for \code{NULL}. \item Unlike base R \code{is.numeric()}, \code{is_bare_double()} only returns \code{TRUE} for floating point numbers. } } \seealso{ \link{type-predicates}, \link{scalar-type-predicates} } rlang/man/op-get-attr.Rd0000644000176200001440000000055113241233650014562 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{op-get-attr} \alias{op-get-attr} \alias{\%@\%} \title{Infix attribute accessor} \usage{ x \%@\% name } \arguments{ \item{x}{Object} \item{name}{Attribute name} } \description{ Infix attribute accessor } \examples{ factor(1:3) \%@\% "levels" mtcars \%@\% "class" } rlang/man/is_named.Rd0000644000176200001440000000340413241233650014176 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attr.R \name{is_named} \alias{is_named} \alias{is_dictionaryish} \alias{have_name} \title{Is object named?} \usage{ is_named(x) is_dictionaryish(x) have_name(x) } \arguments{ \item{x}{An object to test.} } \value{ \code{is_named()} and \code{is_dictionaryish()} are scalar predicates and return \code{TRUE} or \code{FALSE}. \code{have_name()} is vectorised and returns a logical vector as long as the input. } \description{ \code{is_named()} checks that \code{x} has names attributes, and that none of the names are missing or empty (\code{NA} or \code{""}). \code{is_dictionaryish()} checks that an object is a dictionary: that it has actual names and in addition that there are no duplicated names. \code{have_name()} is a vectorised version of \code{is_named()}. } \examples{ # A data frame usually has valid, unique names is_named(mtcars) have_name(mtcars) is_dictionaryish(mtcars) # But data frames can also have duplicated columns: dups <- cbind(mtcars, cyl = seq_len(nrow(mtcars))) is_dictionaryish(dups) # The names are still valid: is_named(dups) have_name(dups) # For empty objects the semantics are slightly different. # is_dictionaryish() returns TRUE for empty objects: is_dictionaryish(list()) # But is_named() will only return TRUE if there is a names # attribute (a zero-length character vector in this case): x <- set_names(list(), character(0)) is_named(x) # Empty and missing names are invalid: invalid <- dups names(invalid)[2] <- "" names(invalid)[5] <- NA # is_named() performs a global check while have_name() can show you # where the problem is: is_named(invalid) have_name(invalid) # have_name() will work even with vectors that don't have a names # attribute: have_name(letters) } rlang/man/chr_unserialise_unicode.Rd0000644000176200001440000000252113241233650017303 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-chr.R \name{chr_unserialise_unicode} \alias{chr_unserialise_unicode} \title{Translate unicode points to UTF-8} \usage{ chr_unserialise_unicode(chr) } \arguments{ \item{chr}{A character vector.} } \description{ For historical reasons, R translates strings to the native encoding when they are converted to symbols. This string-to-symbol conversion is not a rare occurrence and happens for instance to the names of a list of arguments converted to a call by \code{do.call()}. If the string contains unicode characters that cannot be represented in the native encoding, R serialises those as a ASCII sequence representing the unicode point. This is why Windows users with western locales often see strings looking like \code{}. To alleviate some of the pain, rlang parses strings and looks for serialised unicode points to translate them back to the proper UTF-8 representation. This transformation occurs automatically in functions like \code{\link[=env_names]{env_names()}} and can be manually triggered with \code{as_utf8_character()} and \code{chr_unserialise_unicode()}. } \section{Life cycle}{ This function is experimental. } \examples{ ascii <- "" chr_unserialise_unicode(ascii) identical(chr_unserialise_unicode(ascii), "\\u5e78") } \keyword{internal} rlang/man/get_env.Rd0000644000176200001440000000615713241233650014056 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{get_env} \alias{get_env} \alias{set_env} \alias{env_poke_parent} \title{Get or set the environment of an object} \usage{ get_env(env = caller_env(), default = NULL) set_env(env, new_env = caller_env()) env_poke_parent(env, new_env) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{default}{The default environment in case \code{env} does not wrap an environment. If \code{NULL} and no environment could be extracted, an error is issued.} \item{new_env}{An environment to replace \code{env} with. Can be an object handled by \code{get_env()}.} } \description{ These functions dispatch internally with methods for functions, formulas and frames. If called with a missing argument, the environment of the current evaluation frame (see \code{\link[=ctxt_stack]{ctxt_stack()}}) is returned. If you call \code{get_env()} with an environment, it acts as the identity function and the environment is simply returned (this helps simplifying code when writing generic functions for environments). } \details{ While \code{set_env()} returns a modified copy and does not have side effects, \code{env_poke_parent()} operates changes the environment by side effect. This is because environments are \link[=is_copyable]{uncopyable}. Be careful not to change environments that you don't own, e.g. a parent environment of a function from a package. } \examples{ # Get the environment of frame objects. If no argument is supplied, # the current frame is used: fn <- function() { list( get_env(call_frame()), get_env() ) } fn() # Environment of closure functions: get_env(fn) # Or of quosures or formulas: get_env(~foo) get_env(quo(foo)) # Provide a default in case the object doesn't bundle an environment. # Let's create an unevaluated formula: f <- quote(~foo) # The following line would fail if run because unevaluated formulas # don't bundle an environment (they didn't have the chance to # record one yet): # get_env(f) # It is often useful to provide a default when you're writing # functions accepting formulas as input: default <- env() identical(get_env(f, default), default) # set_env() can be used to set the enclosure of functions and # formulas. Let's create a function with a particular environment: env <- child_env("base") fn <- set_env(function() NULL, env) # That function now has `env` as enclosure: identical(get_env(fn), env) identical(get_env(fn), get_env()) # set_env() does not work by side effect. Setting a new environment # for fn has no effect on the original function: other_env <- child_env(NULL) set_env(fn, other_env) identical(get_env(fn), other_env) # Since set_env() returns a new function with a different # environment, you'll need to reassign the result: fn <- set_env(fn, other_env) identical(get_env(fn), other_env) } \seealso{ \code{\link[=quo_get_env]{quo_get_env()}} and \code{\link[=quo_set_env]{quo_set_env()}} for versions of \code{\link[=get_env]{get_env()}} and \code{\link[=set_env]{set_env()}} that only work on quosures. } rlang/man/quosure.Rd0000644000176200001440000000642213241233650014125 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quo.R \name{quosure} \alias{quosure} \alias{is_quosure} \alias{quo_is_missing} \alias{quo_is_symbol} \alias{quo_is_call} \alias{quo_is_symbolic} \alias{quo_is_null} \alias{quo_get_expr} \alias{quo_get_env} \alias{quo_set_expr} \alias{quo_set_env} \alias{is_quosures} \title{Quosure getters, setters and testers} \usage{ is_quosure(x) quo_is_missing(quo) quo_is_symbol(quo, name = NULL) quo_is_call(quo, name = NULL, n = NULL, ns = NULL) quo_is_symbolic(quo) quo_is_null(quo) quo_get_expr(quo) quo_get_env(quo) quo_set_expr(quo, expr) quo_set_env(quo, env) is_quosures(x) } \arguments{ \item{x}{An object to test.} \item{quo}{A quosure to test.} \item{name}{The name of the symbol or function call. If \code{NULL} the name is not tested.} \item{n}{An optional number of arguments that the call should match.} \item{ns}{The namespace of the call. If \code{NULL}, the namespace doesn't participate in the pattern-matching. If an empty string \code{""} and \code{x} is a namespaced call, \code{is_call()} returns \code{FALSE}. If any other string, \code{is_call()} checks that \code{x} is namespaced within \code{ns}.} \item{expr}{A new expression for the quosure.} \item{env}{A new environment for the quosure.} } \description{ You can access the quosure components (its expression and its environment) with: \itemize{ \item \code{\link[=get_expr]{get_expr()}} and \code{\link[=get_env]{get_env()}}. These getters also support other kinds of objects such as formulas \item \code{quo_get_expr()} and \code{quo_get_env()}. These getters only work with quosures and throw an error with other types of input. } Test if an object is a quosure with \code{is_quosure()}. If you know an object is a quosure, use the \code{quo_} prefixed predicates to check its contents, \code{quo_is_missing()}, \code{quo_is_symbol()}, etc. } \section{Empty quosures}{ When missing arguments are captured as quosures, either through \code{\link[=enquo]{enquo()}} or \code{\link[=quos]{quos()}}, they are returned as an empty quosure. These quosures contain the \link[=missing_arg]{missing argument} and typically have the \link[=empty_env]{empty environment} as enclosure. } \section{Life cycle}{ \itemize{ \item \code{is_quosure()} is stable. \item \code{quo_get_expr()} and \code{quo_get_env()} are stable. \item \code{is_quosureish()} is deprecated as of rlang 0.2.0. This function assumed that quosures are formulas which is currently true but might not be in the future. } } \examples{ quo <- quo(my_quosure) quo # Access and set the components of a quosure: quo_get_expr(quo) quo_get_env(quo) quo <- quo_set_expr(quo, quote(baz)) quo <- quo_set_env(quo, empty_env()) quo # Test wether an object is a quosure: is_quosure(quo) # If it is a quosure, you can use the specialised type predicates # to check what is inside it: quo_is_symbol(quo) quo_is_call(quo) quo_is_null(quo) # quo_is_missing() checks for a special kind of quosure, the one # that contains the missing argument: quo() quo_is_missing(quo()) fn <- function(arg) enquo(arg) fn() quo_is_missing(fn()) } \seealso{ \code{\link[=quo]{quo()}} for creating quosures by quotation; \code{\link[=as_quosure]{as_quosure()}} and \code{\link[=new_quosure]{new_quosure()}} for constructing quosures manually. } rlang/man/env_parent.Rd0000644000176200001440000000361713241233650014566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_parent} \alias{env_parent} \alias{env_tail} \alias{env_parents} \title{Get parent environments} \usage{ env_parent(env = caller_env(), n = 1) env_tail(env = caller_env(), sentinel = empty_env()) env_parents(env = caller_env()) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{n}{The number of generations to go up.} \item{sentinel}{The environment signalling the end of the linear search. \code{env_tail()} returns the environment which has \code{sentinel} as parent.} } \value{ An environment for \code{env_parent()} and \code{env_tail()}, a list of environments for \code{env_parents()}. } \description{ \itemize{ \item \code{env_parent()} returns the parent environment of \code{env} if called with \code{n = 1}, the grandparent with \code{n = 2}, etc. \item \code{env_tail()} searches through the parents and returns the one which has \code{\link[=empty_env]{empty_env()}} as parent. \item \code{env_parents()} returns the list of all parents, including the empty environment. } See the section on \emph{inheritance} in \code{\link[=env]{env()}}'s documentation. } \examples{ # Get the parent environment with env_parent(): env_parent(global_env()) # Or the tail environment with env_tail(): env_tail(global_env()) # By default, env_parent() returns the parent environment of the # current evaluation frame. If called at top-level (the global # frame), the following two expressions are equivalent: env_parent() env_parent(base_env()) # This default is more handy when called within a function. In this # case, the enclosure environment of the function is returned # (since it is the parent of the evaluation frame): enclos_env <- env() fn <- set_env(function() env_parent(), enclos_env) identical(enclos_env, fn()) } rlang/man/dictionary.Rd0000644000176200001440000000144613241233650014570 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{dictionary} \alias{dictionary} \alias{as_dictionary} \alias{is_dictionary} \title{Create a dictionary} \usage{ as_dictionary(x, lookup_msg = NULL, read_only = FALSE) is_dictionary(x) } \arguments{ \item{x}{An object for which you want to find associated data.} \item{lookup_msg}{An error message when your data source is accessed inappropriately (by position rather than name).} \item{read_only}{Whether users can replace elements of the dictionary.} } \description{ The dictionary class was soft-deprecated in rlang 0.2.0. It was trying to be too general and did not prove useful. Please use \code{\link[=as_data_pronoun]{as_data_pronoun()}} or your own pronoun class instead. } \keyword{internal} rlang/man/is_function.Rd0000644000176200001440000001046113241233650014740 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fn.R \name{is_function} \alias{is_function} \alias{is_closure} \alias{is_primitive} \alias{is_primitive_eager} \alias{is_primitive_lazy} \title{Is object a function?} \usage{ is_function(x) is_closure(x) is_primitive(x) is_primitive_eager(x) is_primitive_lazy(x) } \arguments{ \item{x}{Object to be tested.} } \description{ The R language defines two different types of functions: primitive functions, which are low-level, and closures, which are the regular kind of functions. } \details{ Closures are functions written in R, named after the way their arguments are scoped within nested environments (see https://en.wikipedia.org/wiki/Closure_(computer_programming)). The root environment of the closure is called the closure environment. When closures are evaluated, a new environment called the evaluation frame is created with the closure environment as parent. This is where the body of the closure is evaluated. These closure frames appear on the evaluation stack (see \code{\link[=ctxt_stack]{ctxt_stack()}}), as opposed to primitive functions which do not necessarily have their own evaluation frame and never appear on the stack. Primitive functions are more efficient than closures for two reasons. First, they are written entirely in fast low-level code. Secondly, the mechanism by which they are passed arguments is more efficient because they often do not need the full procedure of argument matching (dealing with positional versus named arguments, partial matching, etc). One practical consequence of the special way in which primitives are passed arguments this is that they technically do not have formal arguments, and \code{\link[=formals]{formals()}} will return \code{NULL} if called on a primitive function. See \code{\link[=fn_fmls]{fn_fmls()}} for a function that returns a representation of formal arguments for primitive functions. Finally, primitive functions can either take arguments lazily, like R closures do, or evaluate them eagerly before being passed on to the C code. The former kind of primitives are called "special" in R terminology, while the latter is referred to as "builtin". \code{is_primitive_eager()} and \code{is_primitive_lazy()} allow you to check whether a primitive function evaluates arguments eagerly or lazily. You will also encounter the distinction between primitive and internal functions in technical documentation. Like primitive functions, internal functions are defined at a low level and written in C. However, internal functions have no representation in the R language. Instead, they are called via a call to \code{\link[base:.Internal]{base::.Internal()}} within a regular closure. This ensures that they appear as normal R function objects: they obey all the usual rules of argument passing, and they appear on the evaluation stack as any other closures. As a result, \code{\link[=fn_fmls]{fn_fmls()}} does not need to look in the \code{.ArgsEnv} environment to obtain a representation of their arguments, and there is no way of querying from R whether they are lazy ('special' in R terminology) or eager ('builtin'). You can call primitive functions with \code{\link[=.Primitive]{.Primitive()}} and internal functions with \code{\link[=.Internal]{.Internal()}}. However, calling internal functions in a package is forbidden by CRAN's policy because they are considered part of the private API. They often assume that they have been called with correctly formed arguments, and may cause R to crash if you call them with unexpected objects. } \examples{ # Primitive functions are not closures: is_closure(base::c) is_primitive(base::c) # On the other hand, internal functions are wrapped in a closure # and appear as such from the R side: is_closure(base::eval) # Both closures and primitives are functions: is_function(base::c) is_function(base::eval) # Primitive functions never appear in evaluation stacks: is_primitive(base::`[[`) is_primitive(base::list) list(ctxt_stack())[[1]] # While closures do: identity(identity(ctxt_stack())) # Many primitive functions evaluate arguments eagerly: is_primitive_eager(base::c) is_primitive_eager(base::list) is_primitive_eager(base::`+`) # However, primitives that operate on expressions, like quote() or # substitute(), are lazy: is_primitive_lazy(base::quote) is_primitive_lazy(base::substitute) } rlang/man/new_node.Rd0000644000176200001440000000342513241233650014220 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/node.R \name{new_node} \alias{new_node} \alias{node_car} \alias{node_cdr} \alias{node_caar} \alias{node_cadr} \alias{node_cdar} \alias{node_cddr} \alias{node_poke_car} \alias{node_poke_cdr} \alias{node_poke_caar} \alias{node_poke_cadr} \alias{node_poke_cdar} \alias{node_poke_cddr} \alias{node_tag} \alias{node_poke_tag} \title{Helpers for pairlist and language nodes} \usage{ new_node(car, cdr = NULL) node_car(x) node_cdr(x) node_caar(x) node_cadr(x) node_cdar(x) node_cddr(x) node_poke_car(x, newcar) node_poke_cdr(x, newcdr) node_poke_caar(x, newcar) node_poke_cadr(x, newcar) node_poke_cdar(x, newcdr) node_poke_cddr(x, newcdr) node_tag(x) node_poke_tag(x, newtag) } \arguments{ \item{car, newcar, cdr, newcdr}{The new CAR or CDR for the node. These can be any R objects.} \item{x}{A language or pairlist node. Note that these functions are barebones and do not perform any type checking.} \item{newtag}{The new tag for the node. This should be a symbol.} } \value{ Setters like \code{node_poke_car()} invisibly return \code{x} modified in place. Getters return the requested node component. } \description{ \strong{Important}: These functions are for expert R programmers only. You should only use them if you feel comfortable manipulating low level R data structures at the C level. We export them at R level in order to make it easy to prototype C code. They don't perform any type checking and can crash R very easily (try to take the CAR of an integer vector --- save any important object beforehand!). } \seealso{ \code{\link[=duplicate]{duplicate()}} for creating copy-safe objects and \code{\link[base:pairlist]{base::pairlist()}} for an easier way of creating a linked list of nodes. } \keyword{internal} rlang/man/quo_label.Rd0000644000176200001440000000252613241233650014366 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quo.R \name{quo_label} \alias{quo_label} \alias{quo_text} \alias{quo_name} \title{Format quosures for printing or labelling} \usage{ quo_label(quo) quo_text(quo, width = 60L, nlines = Inf) quo_name(quo) } \arguments{ \item{quo}{A quosure or expression.} \item{width}{Width of each line.} \item{nlines}{Maximum number of lines to extract.} } \description{ \itemize{ \item \code{quo_text()} and \code{quo_label()} are equivalent to \code{\link[=expr_text]{expr_text()}}, \code{\link[=expr_label]{expr_label()}}, etc, but they first squash all quosures with \code{\link[=quo_squash]{quo_squash()}} so they print more nicely. \item \code{quo_name()} squashes a quosure and transforms it into a simple string. It is suitable to give an unnamed quosure a default name, for instance a column name in a data frame. } } \examples{ # Quosures can contain nested quosures: quo <- quo(foo(!! quo(bar))) quo # quo_squash() unwraps all quosures and returns a raw expression: quo_squash(quo) # This is used by quo_text() and quo_label(): quo_text(quo) # Compare to the unwrapped expression: expr_text(quo) # quo_name() is helpful when you need really short labels: quo_name(quo(sym)) quo_name(quo(!! sym)) } \seealso{ \code{\link[=expr_label]{expr_label()}}, \code{\link[=f_label]{f_label()}} } rlang/man/dots_n.Rd0000644000176200001440000000063013241233650013703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dots.R \name{dots_n} \alias{dots_n} \title{How many arguments are currently forwarded in dots?} \usage{ dots_n(...) } \arguments{ \item{...}{Forwarded arguments.} } \description{ This returns the number of arguments currently forwarded in \code{...} as an integer. } \examples{ fn <- function(...) dots_n(..., baz) fn(foo, bar) } rlang/man/op-definition.Rd0000644000176200001440000000337613241233650015173 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{op-definition} \alias{op-definition} \alias{is_definition} \alias{new_definition} \alias{is_formulaish} \title{Definition operator} \usage{ is_definition(x) new_definition(lhs, rhs, env = caller_env()) is_formulaish(x, scoped = NULL, lhs = NULL) } \arguments{ \item{x}{An object to test.} \item{lhs, rhs}{Expressions for the LHS and RHS of the definition.} \item{env}{The evaluation environment bundled with the definition.} } \description{ The definition operator is typically used in DSL packages like \code{ggvis} and \code{data.table}. It is also used in the tidyverse as a way of unquoting names (see \link{quasiquotation}). \itemize{ \item \code{is_definition()} returns \code{TRUE} for calls to \code{:=}. \item \code{is_formulaish()} returns \code{TRUE} for both formulas and colon-equals operators. } } \details{ The recommended way to use it is to capture arguments as expressions or quosures. You can then give a special function definition for the \code{:=} symbol in an overscope. Note that if you capture dots with \code{\link[=exprs]{exprs()}} or \code{\link[=quos]{quos()}}, you need to disable interpretation of \code{:=} by setting \code{.unquote_names} to \code{FALSE}. From rlang and data.table perspectives, this operator is not meant to be evaluated directly at top-level which is why the exported definitions issue an error. } \section{Life cycle}{ These functions are experimental. } \examples{ # A predicate is provided to distinguish formulas from the # colon-equals operator: is_definition(quote(a := b)) is_definition(a ~ b) # is_formulaish() tests for both definitions and formulas: is_formulaish(a ~ b) is_formulaish(quote(a := b)) } \keyword{internal} rlang/man/as_pairlist.Rd0000644000176200001440000000100613241233650014725 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/node.R \name{as_pairlist} \alias{as_pairlist} \title{Coerce to pairlist} \usage{ as_pairlist(x) } \arguments{ \item{x}{An object to coerce.} } \description{ This transforms vector objects to a linked pairlist of nodes. See the \link[=node]{pairlist} type help page. } \section{Life cycle}{ \code{as_pairlist()} is experimental because we are still figuring out the naming scheme for pairlists and node-like objects. } \keyword{internal} rlang/man/is_installed.Rd0000644000176200001440000000101513241233650015065 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{is_installed} \alias{is_installed} \title{Is a package installed in the library?} \usage{ is_installed(pkg) } \arguments{ \item{pkg}{The name of a package.} } \value{ \code{TRUE} if the package is installed, \code{FALSE} otherwise. } \description{ This checks that a package is installed with minimal side effects. If installed, the package will be loaded but not attached. } \examples{ is_installed("utils") is_installed("ggplot5") } rlang/man/op-na-default.Rd0000644000176200001440000000115013241233650015047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{op-na-default} \alias{op-na-default} \alias{\%|\%} \title{Replace missing values} \usage{ x \%|\% y } \arguments{ \item{x, y}{\code{y} for elements of \code{x} that are NA; otherwise, \code{x}.} } \description{ This infix function is similar to \code{\%||\%} but is vectorised and provides a default value for missing elements. It is faster than using \code{\link[base:ifelse]{base::ifelse()}} and does not perform type conversions. } \examples{ c("a", "b", NA, "c") \%|\% "default" } \seealso{ \link{op-null-default} } rlang/man/eval_tidy.Rd0000644000176200001440000000575113241233650014406 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval-tidy.R \name{eval_tidy} \alias{eval_tidy} \title{Evaluate an expression with quosures and pronoun support} \usage{ eval_tidy(expr, data = NULL, env = caller_env()) } \arguments{ \item{expr}{An expression to evaluate.} \item{data}{A data frame, or named list or vector. Alternatively, a data mask created with \code{\link[=as_data_mask]{as_data_mask()}} or \code{\link[=new_data_mask]{new_data_mask()}}.} \item{env}{The environment in which to evaluate \code{expr}. This environment is always ignored when evaluating quosures. Quosures are evaluated in their own environment.} } \description{ \code{eval_tidy()} is a variant of \code{\link[base:eval]{base::eval()}} that powers the tidy evaluation framework. Like \code{eval()} it accepts user data as argument. If supplied, it evaluates its input \code{expr} in a \link[=as_data_mask]{data mask}. In additon \code{eval_tidy()} supports: \itemize{ \item \link[=quotation]{Quosures}. The expression wrapped in the quosure evaluates in its original context (masked by \code{data} if supplied). \item \link[=.data]{Pronouns}. If \code{data} is supplied, the \code{.env} and \code{.data} pronouns are installed in the data mask. \code{.env} is a reference to the calling environment and \code{.data} refers to the \code{data} argument. These pronouns lets you be explicit about where to find values and throw errors if you try to access non-existent values. } } \section{Life cycle}{ \code{eval_tidy()} is stable. } \examples{ # With simple quoted expressions eval_tidy() works the same way as # eval(): apple <- "apple" kiwi <- "kiwi" expr <- quote(paste(apple, kiwi)) expr eval(expr) eval_tidy(expr) # Both accept a data mask as argument: data <- list(apple = "CARROT", kiwi = "TOMATO") eval(expr, data) eval_tidy(expr, data) # In addition eval_tidy() has support for quosures: with_data <- function(data, expr) { quo <- enquo(expr) eval_tidy(quo, data) } with_data(NULL, apple) with_data(data, apple) with_data(data, list(apple, kiwi)) # Secondly eval_tidy() installs handy pronouns that allows users to # be explicit about where to find symbols: with_data(data, .data$apple) with_data(data, .env$apple) # Note that instead of using `.env` it is often equivalent and may # be preferred to unquote a value. There are two differences. First # unquoting happens earlier, when the quosure is created. Secondly, # subsetting `.env` with the `$` operator may be brittle because # `$` does not look through the parents of the environment. # # For instance using `.env$name` in a magrittr pipeline is an # instance where this poses problem, because the magrittr pipe # currently (as of v1.5.0) evaluates its operands in a *child* of # the current environment (this child environment is where it # defines the pronoun `.`). \dontrun{ data \%>\% with_data(!!kiwi) # "kiwi" data \%>\% with_data(.env$kiwi) # NULL } } \seealso{ \link{quasiquotation} for the second leg of the tidy evaluation framework. } rlang/man/tidy-dots.Rd0000644000176200001440000000637713241305652014355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dots.R, R/vec-new.R \name{tidy-dots} \alias{tidy-dots} \alias{dots_list} \alias{list2} \title{Collect dots tidily} \usage{ dots_list(..., .ignore_empty = c("trailing", "none", "all")) list2(...) } \arguments{ \item{...}{Arguments with explicit (\code{dots_list()}) or list (\code{dots_splice()}) splicing semantics. The contents of spliced arguments are embedded in the returned list.} \item{.ignore_empty}{Whether to ignore empty arguments. Can be one of \code{"trailing"}, \code{"none"}, \code{"all"}. If \code{"trailing"}, only the last argument is ignored if it is empty.} } \value{ A list of arguments. This list is always named: unnamed arguments are named with the empty string \code{""}. } \description{ \code{list2()} is equivalent to \code{list(...)} but provides tidy dots semantics: \itemize{ \item You can splice other lists with the \link[=quasiquotation]{unquote-splice} \code{!!!} operator. \item You can unquote names by using the \link[=quasiquotation]{unquote} operator \code{!!} on the left-hand side of \code{:=}. } We call quasiquotation support in dots \strong{tidy dots} semantics and functions taking dots with \code{list2()} tidy dots functions. Quasiquotation is an alternative to \code{do.call()} idioms and gives the users of your functions an uniform syntax to supply a variable number of arguments or a variable name. \code{dots_list()} is a lower-level version of \code{list2()} that offers additional parameters for dots capture. } \details{ Note that while all tidy eval \link[=quotation]{quoting functions} have tidy dots semantics, not all tidy dots functions are quoting functions. \code{list2()} is for standard functions, not quoting functions. } \section{Life cycle}{ One difference of \code{dots_list()} with \code{list2()} is that it always allocates a vector of names even if no names were supplied. In this case, the names are all empty \code{""}. This is for consistency with \code{\link[=enquos]{enquos()}} and \code{\link[=enexprs]{enexprs()}} but can be quite costly when long lists are spliced in the results. For this reason we plan to parameterise this behaviour with a \code{.named} argument and possibly change the default. \code{list2()} does not have this issue. } \examples{ # Let's create a function that takes a variable number of arguments: numeric <- function(...) { dots <- list2(...) num <- as.numeric(dots) set_names(num, names(dots)) } numeric(1, 2, 3) # The main difference with list(...) is that list2(...) enables # the `!!!` syntax to splice lists: x <- list(2, 3) numeric(1, !!! x, 4) # As well as unquoting of names: nm <- "yup!" numeric(!!nm := 1) # One useful application of splicing is to work around exact and # partial matching of arguments. Let's create a function taking # named arguments and dots: fn <- function(data, ...) { list2(...) } # You normally cannot pass an argument named `data` through the dots # as it will match `fn`'s `data` argument. The splicing syntax # provides a workaround: fn("wrong!", data = letters) # exact matching of `data` fn("wrong!", dat = letters) # partial matching of `data` fn(some_data, !!! list(data = letters)) # no matching } \seealso{ \code{\link[=exprs]{exprs()}} for extracting dots without evaluation. } rlang/man/env_inherits.Rd0000644000176200001440000000103513241233650015112 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_inherits} \alias{env_inherits} \title{Does environment inherit from another environment?} \usage{ env_inherits(env, ancestor) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} \item{ancestor}{Another environment from which \code{x} might inherit.} } \description{ This returns \code{TRUE} if \code{x} has \code{ancestor} among its parents. } rlang/man/expr_interp.Rd0000644000176200001440000000335013241233650014756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quasiquotation.R \name{expr_interp} \alias{expr_interp} \title{Process unquote operators in a captured expression} \usage{ expr_interp(x, env = NULL) } \arguments{ \item{x}{A function, raw expression, or formula to interpolate.} \item{env}{The environment in which unquoted expressions should be evaluated. By default, the formula or closure environment if a formula or a function, or the current environment otherwise.} } \description{ While all capturing functions in the tidy evaluation framework perform unquote on capture (most notably \code{\link[=quo]{quo()}}), \code{expr_interp()} manually processes unquoting operators in expressions that are already captured. \code{expr_interp()} should be called in all user-facing functions expecting a formula as argument to provide the same quasiquotation functionality as NSE functions. } \examples{ # All tidy NSE functions like quo() unquote on capture: quo(list(!!(1 + 2))) # expr_interp() is meant to provide the same functionality when you # have a formula or expression that might contain unquoting # operators: f <- ~list(!!(1 + 2)) expr_interp(f) # Note that only the outer formula is unquoted (which is a reason # to use expr_interp() as early as possible in all user-facing # functions): f <- ~list(~!!(1 + 2), !!(1 + 2)) expr_interp(f) # Another purpose for expr_interp() is to interpolate a closure's # body. This is useful to inline a function within another. The # important limitation is that all formal arguments of the inlined # function should be defined in the receiving function: other_fn <- function(x) toupper(x) fn <- expr_interp(function(x) { x <- paste0(x, "_suffix") !!! body(other_fn) }) fn fn("foo") } rlang/man/as_function.Rd0000644000176200001440000000252013241233650014725 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fn.R \name{as_function} \alias{as_function} \alias{as_closure} \title{Convert to function or closure} \usage{ as_function(x, env = caller_env()) as_closure(x, env = caller_env()) } \arguments{ \item{x}{A function or formula. If a \strong{function}, it is used as is. If a \strong{formula}, e.g. \code{~ .x + 2}, it is converted to a function with two arguments, \code{.x} or \code{.} and \code{.y}. This allows you to create very compact anonymous functions with up to two inputs.} \item{env}{Environment in which to fetch the function in case \code{x} is a string.} } \description{ \itemize{ \item \code{as_function()} transform objects to functions. It fetches functions by name if supplied a string or transforms \link[=quotation]{quosures} to a proper function. \item \code{as_closure()} first passes its argument to \code{as_function()}. If the result is a primitive function, it regularises it to a proper \link{closure} (see \code{\link[=is_function]{is_function()}} about primitive functions). } } \examples{ f <- as_function(~ . + 1) f(10) # Primitive functions are regularised as closures as_closure(list) as_closure("list") # Operators have `.x` and `.y` as arguments, just like lambda # functions created with the formula syntax: as_closure(`+`) as_closure(`~`) } rlang/man/cnd.Rd0000644000176200001440000000367213241304332013166 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd.R \name{cnd} \alias{cnd} \alias{error_cnd} \alias{warning_cnd} \alias{message_cnd} \title{Create a condition object} \usage{ cnd(.type = NULL, ..., .msg = NULL) error_cnd(.type = NULL, ..., .msg = NULL) warning_cnd(.type = NULL, ..., .msg = NULL) message_cnd(.type = NULL, ..., .msg = NULL) } \arguments{ \item{.type}{The condition subclass.} \item{...}{Named data fields stored inside the condition object. These dots are evaluated with \link[=tidy-dots]{explicit splicing}.} \item{.msg}{A default message to inform the user about the condition when it is signalled.} } \description{ These constructors make it easy to create subclassed conditions. Conditions are objects that power the error system in R. They can also be used for passing messages to pre-established handlers. } \details{ \code{cnd()} creates objects inheriting from \code{condition}. Conditions created with \code{error_cnd()}, \code{warning_cnd()} and \code{message_cnd()} inherit from \code{error}, \code{warning} or \code{message}. } \examples{ # Create a condition inheriting from the s3 type "foo": cnd <- cnd("foo") # Signal the condition to potential handlers. This has no effect if no # handler is registered to deal with conditions of type "foo": cnd_signal(cnd) # If a relevant handler is on the current evaluation stack, it will be # called by cnd_signal(): with_handlers(cnd_signal(cnd), foo = exiting(function(c) "caught!")) # Handlers can be thrown or executed inplace. See with_handlers() # documentation for more on this. # Note that merely signalling a condition inheriting of "error" is # not sufficient to stop a program: cnd_signal(error_cnd("my_error")) # you need to use stop() to signal a critical condition that should # terminate the program if not handled: # stop(error_cnd("my_error")) } \seealso{ \code{\link[=cnd_signal]{cnd_signal()}}, \code{\link[=with_handlers]{with_handlers()}}. } rlang/man/is_copyable.Rd0000644000176200001440000000173413241233650014714 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{is_copyable} \alias{is_copyable} \title{Is an object copyable?} \usage{ is_copyable(x) } \arguments{ \item{x}{An object to test.} } \description{ When an object is modified, R generally copies it (sometimes lazily) to enforce \href{https://en.wikipedia.org/wiki/Value_semantics}{valuesemantics}. However, some internal types are uncopyable. If you try to copy them, either with \code{<-} or by argument passing, you actually create references to the original object rather than actual copies. Modifying these references can thus have far reaching side effects. } \examples{ # Let's add attributes with structure() to uncopyable types. Since # they are not copied, the attributes are changed in place: env <- env() structure(env, foo = "bar") env # These objects that can only be changed with side effect are not # copyable: is_copyable(env) structure(base::list, foo = "bar") str(base::list) } rlang/man/is_frame.Rd0000644000176200001440000000036213241233650014204 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{is_frame} \alias{is_frame} \title{Is object a frame?} \usage{ is_frame(x) } \arguments{ \item{x}{Object to test} } \description{ Is object a frame? } rlang/man/restarting.Rd0000644000176200001440000000465013241305652014607 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd-handlers.R \name{restarting} \alias{restarting} \title{Create a restarting handler} \usage{ restarting(.restart, ..., .fields = NULL) } \arguments{ \item{.restart}{The name of a restart.} \item{...}{Additional arguments passed on the restart function. These arguments are evaluated only once and immediately, when creating the restarting handler. Furthermore, they support \link[=tidy-dots]{tidy dots} features.} \item{.fields}{A character vector specifying the fields of the condition that should be passed as arguments to the restart. If named, the names (except empty names \code{""}) are used as argument names for calling the restart function. Otherwise the the fields themselves are used as argument names.} } \description{ This constructor automates the common task of creating an \code{\link[=inplace]{inplace()}} handler that invokes a restart. } \details{ Jumping to a restart point from an inplace handler has two effects. First, the control flow jumps to wherever the restart was established, and the restart function is called (with \code{...}, or \code{.fields} as arguments). Execution resumes from the \code{\link[=with_restarts]{with_restarts()}} call. Secondly, the transfer of the control flow out of the function that signalled the condition means that the handler has dealt with the condition. Thus the condition will not be passed on to other potential handlers established on the stack. } \examples{ # This is a restart that takes a data frame and names as arguments rst_bar <- function(df, nms) { stats::setNames(df, nms) } # This restart is simpler and does not take arguments rst_baz <- function() "baz" # Signalling a condition parameterised with a data frame fn <- function() { with_restarts(cnd_signal("foo", foo_field = mtcars), rst_bar = rst_bar, rst_baz = rst_baz ) } # Creating a restarting handler that passes arguments `nms` and # `df`, the latter taken from a data field of the condition object restart_bar <- restarting("rst_bar", nms = LETTERS[1:11], .fields = c(df = "foo_field") ) # The restarting handlers jumps to `rst_bar` when `foo` is signalled: with_handlers(fn(), foo = restart_bar) # The restarting() constructor is especially nice to use with # restarts that do not need arguments: with_handlers(fn(), foo = restarting("rst_baz")) } \seealso{ \code{\link[=inplace]{inplace()}} and \code{\link[=exiting]{exiting()}}. } rlang/man/as_data_mask.Rd0000644000176200001440000001171113241233650015026 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval-tidy.R \name{as_data_mask} \alias{as_data_mask} \alias{as_data_pronoun} \alias{new_data_mask} \title{Create a data mask} \usage{ as_data_mask(data, parent = base_env()) as_data_pronoun(data) new_data_mask(bottom, top = bottom, parent = base_env()) } \arguments{ \item{data}{A data frame or named vector of masking data.} \item{parent}{The parent environment of the data mask.} \item{bottom}{The environment containing masking objects if the data mask is one environment deep. The bottom environment if the data mask comprises multiple environment.} \item{top}{The last environment of the data mask. If the data mask is only one environment deep, \code{top} should be the same as \code{bottom}.} } \value{ A data mask that you can supply to \code{\link[=eval_tidy]{eval_tidy()}}. } \description{ A data mask is an environment (or possibly multiple environments forming an ancestry) containing user-supplied objects. Objects in the mask have precedence over objects in the environment (i.e. they mask those objects). Many R functions evaluate quoted expressions in a data mask so these expressions can refer to objects within the user data. These functions let you construct a tidy eval data mask manually. They are meant for developers of tidy eval interfaces rather than for end users. Most of the time you can just call \code{\link[=eval_tidy]{eval_tidy()}} with user data and the data mask will be constructed automatically. There are three main use cases for manual creation of data masks: \itemize{ \item When \code{\link[=eval_tidy]{eval_tidy()}} is called with the same data in a tight loop. Tidy eval data masks are a bit expensive to build so it is best to construct it once and reuse it the other times for optimal performance. \item When several expressions should be evaluated in the same environment because a quoted expression might create new objects that can be referred in other quoted expressions evaluated at a later time. \item When your data mask requires special features. For instance the data frame columns in dplyr data masks are implemented with \link[base:delayedAssign]{active bindings}. } } \section{Building your own data mask}{ Creating a data mask for \code{\link[base:eval]{base::eval()}} is a simple matter of creating an environment containing masking objects that has the user context as parent. \code{eval()} automates this task when you supply data as second argument. However a tidy eval data mask also needs to enable support of \link[=quotation]{quosures} and \link[=tidyeval-data]{data pronouns}. These functions allow manual construction of tidy eval data masks: \itemize{ \item \code{as_data_mask()} transforms a data frame, named vector or environment to a data mask. If an environment, its ancestry is ignored. It automatically installs a data pronoun. \item \code{new_data_mask()} is a bare bones data mask constructor for environments. You can supply a bottom and a top environment in case your data mask comprises multiple environments. Unlike \code{as_data_mask()} it does not install the \code{.data} pronoun so you need to provide one yourself. You can provide a pronoun constructed with \code{as_data_pronoun()} or your own pronoun class. } \itemize{ \item \code{as_data_pronoun()} constructs a tidy eval data pronoun that gives more useful error messages than regular data frames or lists, i.e. when an object does not exist or if an user tries to overwrite an object. } To use a a data mask, just supply it to \code{\link[=eval_tidy]{eval_tidy()}} as \code{data} argument. You can repeat this as many times as needed. Note that any objects created there (perhaps because of a call to \code{<-}) will persist in subsequent evaluations: } \section{Life cycle}{ All these functions are now stable. In early versions of rlang data masks were called overscopes. We think data mask is a more natural name in R. It makes reference to masking in the search path which occurs through the same mechanism (in technical terms, lexical scoping with hierarchically nested environments). We say that that objects from user data mask objects in the current environment. Following this change in terminology, \code{as_data_mask()} and \code{new_overscope()} were soft-deprecated in rlang 0.2.0 in favour of \code{as_data_mask()} and \code{new_data_mask()}. } \examples{ # Evaluating in a tidy evaluation environment enables all tidy # features: mask <- as_data_mask(mtcars) eval_tidy(quo(letters), mask) # You can install new pronouns in the mask: mask$.pronoun <- as_data_pronoun(list(foo = "bar", baz = "bam")) eval_tidy(quo(.pronoun$foo), mask) # In some cases the data mask can leak to the user, for example if # a function or formula is created in the data mask environment: cyl <- "user variable from the context" fn <- eval_tidy(quote(function() cyl), mask) fn() # If new objects are created in the mask, they persist in the # subsequent calls: eval_tidy(quote(new <- cyl + am), mask) eval_tidy(quote(new * 2), mask) } rlang/man/type-predicates.Rd0000644000176200001440000000313413241233650015521 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{type-predicates} \alias{type-predicates} \alias{is_list} \alias{is_atomic} \alias{is_vector} \alias{is_integer} \alias{is_double} \alias{is_character} \alias{is_logical} \alias{is_raw} \alias{is_bytes} \alias{is_null} \title{Type predicates} \usage{ is_list(x, n = NULL) is_atomic(x, n = NULL) is_vector(x, n = NULL) is_integer(x, n = NULL) is_double(x, n = NULL, finite = NULL) is_character(x, n = NULL, encoding = NULL) is_logical(x, n = NULL) is_raw(x, n = NULL) is_bytes(x, n = NULL) is_null(x) } \arguments{ \item{x}{Object to be tested.} \item{n}{Expected length of a vector.} \item{finite}{Whether values must be finite. Examples of non-finite values are \code{Inf}, \code{-Inf} and \code{NaN}.} \item{encoding}{Expected encoding of a string or character vector. One of \code{UTF-8}, \code{latin1}, or \code{unknown}.} } \description{ These type predicates aim to make type testing in R more consistent. They are wrappers around \code{\link[base:typeof]{base::typeof()}}, so operate at a level beneath S3/S4 etc. } \details{ Compared to base R functions: \itemize{ \item The predicates for vectors include the \code{n} argument for pattern-matching on the vector length. \item Unlike \code{is.atomic()}, \code{is_atomic()} does not return \code{TRUE} for \code{NULL}. \item Unlike \code{is.vector()}, \code{is_vector()} test if an object is an atomic vector or a list. \code{is.vector} checks for the presence of attributes (other than name). } } \seealso{ \link{bare-type-predicates} \link{scalar-type-predicates} } rlang/man/box.Rd0000644000176200001440000000317713241233650013216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/s3.R \name{box} \alias{box} \alias{new_box} \alias{is_box} \alias{as_box} \alias{as_box_if} \alias{unbox} \title{Box a value} \usage{ new_box(x, class = NULL) is_box(x, class = NULL) as_box(x, class = NULL) as_box_if(.x, .p, .class = NULL, ...) unbox(box) } \arguments{ \item{x, .x}{An R object.} \item{class, .class}{For \code{new_box()}, an additional class for the boxed value (in addition to \code{rlang_box}). For \code{is_box()}, \code{as_box()} and \code{as_box_if()}, a class (or vector of classes) to be passed to \code{\link[=inherits_all]{inherits_all()}}.} \item{.p}{A predicate function.} \item{...}{Arguments passed to \code{.p}.} \item{box}{A boxed value to unbox.} } \description{ \code{new_box()} is similar to \code{\link[base:I]{base::I()}} but it protects a value by wrapping it in a scalar list rather than by adding an attribute. \code{unbox()} retrieves the boxed value. \code{is_box()} tests whether an object is boxed with optional class. \code{as_box()} ensures that a value is wrapped in a box. \code{as_box_if()} does the same but only if the value matches a predicate. } \examples{ boxed <- new_box(letters, "mybox") is_box(boxed) is_box(boxed, "mybox") is_box(boxed, "otherbox") unbox(boxed) # as_box() avoids double-boxing: boxed2 <- as_box(boxed, "mybox") boxed2 unbox(boxed2) # Compare to: boxed_boxed <- new_box(boxed, "mybox") boxed_boxed unbox(unbox(boxed_boxed)) # Use `as_box_if()` with a predicate if you need to ensure a box # only for a subset of values: as_box_if(NULL, is_null, "null_box") as_box_if("foo", is_null, "null_box") } rlang/man/eval_tidy_.Rd0000644000176200001440000000156413241233650014543 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{eval_tidy_} \alias{eval_tidy_} \title{Tidy evaluation in a custom environment} \usage{ eval_tidy_(expr, bottom, top = NULL, env = caller_env()) } \arguments{ \item{expr}{An expression to evaluate.} \item{bottom}{The environment containing masking objects if the data mask is one environment deep. The bottom environment if the data mask comprises multiple environment.} \item{top}{The last environment of the data mask. If the data mask is only one environment deep, \code{top} should be the same as \code{bottom}.} \item{env}{The environment in which to evaluate \code{expr}. This environment is always ignored when evaluating quosures. Quosures are evaluated in their own environment.} } \description{ This function is soft-deprecated as of rlang 0.2.0. } \keyword{internal} rlang/man/vec_poke_n.Rd0000644000176200001440000000201113241233650014520 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec.R \name{vec_poke_n} \alias{vec_poke_n} \alias{vec_poke_range} \title{Poke values into a vector} \usage{ vec_poke_n(x, start, y, from = 1L, n = length(y)) vec_poke_range(x, start, y, from = 1L, to = length(y) - from + 1L) } \arguments{ \item{x}{The destination vector.} \item{start}{The index indicating where to start modifying \code{x}.} \item{y}{The source vector.} \item{from}{The index indicating where to start copying from \code{y}.} \item{n}{How many elements should be copied from \code{y} to \code{x}.} \item{to}{The index indicating the end of the range to copy from \code{y}.} } \description{ These tools are for R experts only. They copy elements from \code{y} into \code{x} by mutation. You should only do this if you own \code{x}, i.e. if you have created it or if you are certain that it doesn't exist in any other context. Otherwise you might create unintended side effects that have undefined consequences. } \keyword{internal} rlang/man/are_na.Rd0000644000176200001440000000261713241233650013651 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-na.R \name{are_na} \alias{are_na} \alias{is_na} \alias{is_lgl_na} \alias{is_int_na} \alias{is_dbl_na} \alias{is_chr_na} \alias{is_cpl_na} \title{Test for missing values} \usage{ are_na(x) is_na(x) is_lgl_na(x) is_int_na(x) is_dbl_na(x) is_chr_na(x) is_cpl_na(x) } \arguments{ \item{x}{An object to test} } \description{ \code{are_na()} checks for missing values in a vector and is equivalent to \code{\link[base:is.na]{base::is.na()}}. It is a vectorised predicate, meaning that its output is always the same length as its input. On the other hand, \code{is_na()} is a scalar predicate and always returns a scalar boolean, \code{TRUE} or \code{FALSE}. If its input is not scalar, it returns \code{FALSE}. Finally, there are typed versions that check for particular \link[=missing]{missing types}. } \details{ The scalar predicates accept non-vector inputs. They are equivalent to \code{\link[=is_null]{is_null()}} in that respect. In contrast the vectorised predicate \code{are_na()} requires a vector input since it is defined over vector values. } \examples{ # are_na() is vectorised and works regardless of the type are_na(c(1, 2, NA)) are_na(c(1L, NA, 3L)) # is_na() checks for scalar input and works for all types is_na(NA) is_na(na_dbl) is_na(character(0)) # There are typed versions as well: is_lgl_na(NA) is_lgl_na(na_dbl) } rlang/man/is_stack.Rd0000644000176200001440000000050513241233650014216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{is_stack} \alias{is_stack} \alias{is_eval_stack} \alias{is_call_stack} \title{Is object a stack?} \usage{ is_stack(x) is_eval_stack(x) is_call_stack(x) } \arguments{ \item{x}{An object to test} } \description{ Is object a stack? } rlang/man/call_standardise.Rd0000644000176200001440000000155113241233650015714 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/call.R \name{call_standardise} \alias{call_standardise} \title{Standardise a call} \usage{ call_standardise(call, env = caller_env()) } \arguments{ \item{call}{Can be a call or a quosure that wraps a call.} \item{env}{The environment where to find the definition of the function quoted in \code{call} in case \code{call} is not wrapped in a quosure.} } \value{ A quosure if \code{call} is a quosure, a raw call otherwise. } \description{ This is essentially equivalent to \code{\link[base:match.call]{base::match.call()}}, but with experimental handling of primitive functions. } \section{Life cycle}{ In rlang 0.2.0, \code{lang_standardise()} was soft-deprecated and renamed to \code{call_standardise()}. See lifecycle section in \code{\link[=call2]{call2()}} for more about this change. } rlang/man/type_of.Rd0000644000176200001440000000255313241233650014070 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{type_of} \alias{type_of} \title{Base type of an object} \usage{ type_of(x) } \arguments{ \item{x}{An R object.} } \description{ This is equivalent to \code{\link[base:typeof]{base::typeof()}} with a few differences that make dispatching easier: \itemize{ \item The type of one-sided formulas is "quote". \item The type of character vectors of length 1 is "string". \item The type of special and builtin functions is "primitive". } } \section{Life cycle}{ \code{type_of()} is an experimental function. Expect API changes. } \examples{ type_of(10L) # Quosures are treated as a new base type but not formulas: type_of(quo(10L)) type_of(~10L) # Compare to base::typeof(): typeof(quo(10L)) # Strings are treated as a new base type: type_of(letters) type_of(letters[[1]]) # This is a bit inconsistent with the core language tenet that data # types are vectors. However, treating strings as a different # scalar type is quite helpful for switching on function inputs # since so many arguments expect strings: switch_type("foo", character = abort("vector!"), string = "result") # Special and builtin primitives are both treated as primitives. # That's because it is often irrelevant which type of primitive an # input is: typeof(list) typeof(`$`) type_of(list) type_of(`$`) } \keyword{internal} rlang/man/deprecated-cnd.Rd0000644000176200001440000000203013241304332015247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{deprecated-cnd} \alias{deprecated-cnd} \alias{new_cnd} \alias{cnd_error} \alias{cnd_warning} \alias{cnd_message} \title{Deprecated condition constructors} \usage{ new_cnd(.type = NULL, ..., .msg = NULL) cnd_error(.type = NULL, ..., .msg = NULL) cnd_warning(.type = NULL, ..., .msg = NULL) cnd_message(.type = NULL, ..., .msg = NULL) } \arguments{ \item{.type}{The condition subclass.} \item{...}{Named data fields stored inside the condition object. These dots are evaluated with \link[=tidy-dots]{explicit splicing}.} \item{.msg}{A default message to inform the user about the condition when it is signalled.} } \description{ These functions were deprecated in rlang 0.2.0 to follow the convention that return types are indicated as suffixes. Please use \code{\link[=cnd]{cnd()}}, \code{\link[=error_cnd]{error_cnd()}}, \code{\link[=warning_cnd]{warning_cnd()}} and \code{\link[=message_cnd]{message_cnd()}} instead. } \keyword{internal} rlang/man/exprs_auto_name.Rd0000644000176200001440000000165013241233650015611 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quotation.R \name{exprs_auto_name} \alias{exprs_auto_name} \alias{quos_auto_name} \title{Ensure that list of expressions are all named} \usage{ exprs_auto_name(exprs, width = 60L, printer = expr_text) quos_auto_name(quos, width = 60L) } \arguments{ \item{exprs}{A list of expressions.} \item{width}{Maximum width of names.} \item{printer}{A function that takes an expression and converts it to a string. This function must take an expression as first argument and \code{width} as second argument.} \item{quos}{A list of quosures.} } \description{ This gives default names to unnamed elements of a list of expressions (or expression wrappers such as formulas or quosures). \code{exprs_auto_name()} deparses the expressions with \code{\link[=expr_text]{expr_text()}} by default. \code{quos_auto_name()} deparses with \code{\link[=quo_text]{quo_text()}}. } rlang/man/is_symbol.Rd0000644000176200001440000000050313241233650014414 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sym.R \name{is_symbol} \alias{is_symbol} \title{Is object a symbol?} \usage{ is_symbol(x, name = NULL) } \arguments{ \item{x}{An object to test.} \item{name}{An optional name that the symbol should match.} } \description{ Is object a symbol? } rlang/man/parse_expr.Rd0000644000176200001440000000473513241265017014601 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R, R/parse.R \name{parse_quosures} \alias{parse_quosures} \alias{parse_expr} \alias{parse_exprs} \alias{parse_quo} \alias{parse_quos} \title{Parse R code} \usage{ parse_quosures(x, env = caller_env()) parse_expr(x) parse_exprs(x) } \arguments{ \item{x}{Text containing expressions to parse_expr for \code{parse_expr()} and \code{parse_exprs()}. Can also be an R connection, for instance to a file. If the supplied connection is not open, it will be automatically closed and destroyed.} \item{env}{The environment for the quosures. Depending on the use case, a good default might be the \link[=global_env]{global environment} but you might also want to evaluate the R code in an isolated context (perhaps a child of the global environment or of the \link[=base_env]{base environment}).} } \value{ \code{parse_expr()} returns an \link[=is_expression]{expression}, \code{parse_exprs()} returns a list of expressions. } \description{ These functions parse and transform text into R expressions. This is the first step to interpret or evaluate a piece of R code written by a programmer. } \details{ \code{parse_expr()} returns one expression. If the text contains more than one expression (separated by semicolons or new lines), an error is issued. On the other hand \code{parse_exprs()} can handle multiple expressions. It always returns a list of expressions (compare to \code{\link[base:parse]{base::parse()}} which returns an base::expression vector). All functions also support R connections. The versions suffixed with \code{_quo} and \code{quos} return \link[=quotation]{quosures} rather than raw expressions. } \section{Life cycle}{ \itemize{ \item \code{parse_quosure()} and \code{parse_quosures()} were soft-deprecated in rlang 0.2.0 and renamed to \code{parse_quo()} and \code{parse_quos()}. This is consistent with the rule that abbreviated suffixes indicate the return type of a function. } } \examples{ # parse_expr() can parse any R expression: parse_expr("mtcars \%>\% dplyr::mutate(cyl_prime = cyl / sd(cyl))") # A string can contain several expressions separated by ; or \\n parse_exprs("NULL; list()\\n foo(bar)") # You can also parse source files by passing a R connection. Let's # create a file containing R code: path <- tempfile("my-file.R") cat("1; 2; mtcars", file = path) # We can now parse it by supplying a connection: parse_exprs(file(path)) } \seealso{ \code{\link[base:parse]{base::parse()}} } rlang/man/op-null-default.Rd0000644000176200001440000000100013241233650015415 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{op-null-default} \alias{op-null-default} \alias{\%||\%} \title{Default value for \code{NULL}} \usage{ x \%||\% y } \arguments{ \item{x, y}{If \code{x} is NULL, will return \code{y}; otherwise returns \code{x}.} } \description{ This infix function makes it easy to replace \code{NULL}s with a default value. It's inspired by the way that Ruby's or operation (\code{||}) works. } \examples{ 1 \%||\% 2 NULL \%||\% 2 } rlang/man/is_true.Rd0000644000176200001440000000071013241233650014066 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{is_true} \alias{is_true} \alias{is_false} \title{Is object identical to TRUE or FALSE?} \usage{ is_true(x) is_false(x) } \arguments{ \item{x}{object to test} } \description{ These functions bypass R's automatic conversion rules and check that \code{x} is literally \code{TRUE} or \code{FALSE}. } \examples{ is_true(TRUE) is_true(1) is_false(FALSE) is_false(0) } rlang/man/vector-old-ctors.Rd0000644000176200001440000000171613241233650015631 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{vector-old-ctors} \alias{vector-old-ctors} \alias{lgl_len} \alias{int_len} \alias{dbl_len} \alias{chr_len} \alias{cpl_len} \alias{raw_len} \alias{bytes_len} \alias{list_len} \alias{lgl_along} \alias{int_along} \alias{dbl_along} \alias{chr_along} \alias{cpl_along} \alias{raw_along} \alias{bytes_along} \alias{list_along} \alias{node} \title{Retired vector construction by length} \usage{ lgl_len(.n) int_len(.n) dbl_len(.n) chr_len(.n) cpl_len(.n) raw_len(.n) bytes_len(.n) list_len(.n) lgl_along(.x) int_along(.x) dbl_along(.x) chr_along(.x) cpl_along(.x) raw_along(.x) bytes_along(.x) list_along(.x) node(car, cdr = NULL) } \arguments{ \item{.x}{A vector.} } \description{ These functions were soft-deprecated and renamed with \code{new_} prefix in rlang 0.2.0. This is for consistency with other non-variadic object constructors. } \keyword{internal} rlang/man/is_lang.Rd0000644000176200001440000000243213241233650014033 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{is_lang} \alias{is_lang} \alias{is_unary_lang} \alias{is_binary_lang} \alias{quo_is_lang} \title{Is object a call?} \usage{ is_lang(x, name = NULL, n = NULL, ns = NULL) is_unary_lang(x, name = NULL, ns = NULL) is_binary_lang(x, name = NULL, ns = NULL) quo_is_lang(quo) } \arguments{ \item{x}{An object to test. If a formula, the right-hand side is extracted.} \item{name}{An optional name that the call should match. It is passed to \code{\link[=sym]{sym()}} before matching. This argument is vectorised and you can supply a vector of names to match. In this case, \code{is_call()} returns \code{TRUE} if at least one name matches.} \item{n}{An optional number of arguments that the call should match.} \item{ns}{The namespace of the call. If \code{NULL}, the namespace doesn't participate in the pattern-matching. If an empty string \code{""} and \code{x} is a namespaced call, \code{is_call()} returns \code{FALSE}. If any other string, \code{is_call()} checks that \code{x} is namespaced within \code{ns}.} \item{quo}{A quosure to test.} } \description{ These functions are soft-deprecated, please use \code{\link[=is_call]{is_call()}} and its \code{n} argument instead. } \keyword{internal} rlang/man/has_length.Rd0000644000176200001440000000133613241233650014535 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/attr.R \name{has_length} \alias{has_length} \title{How long is an object?} \usage{ has_length(x, n = NULL) } \arguments{ \item{x}{A R object.} \item{n}{A specific length to test \code{x} with. If \code{NULL}, \code{has_length()} returns \code{TRUE} if \code{x} has length greater than zero, and \code{FALSE} otherwise.} } \description{ This is a function for the common task of testing the length of an object. It checks the length of an object in a non-generic way: \code{\link[base:length]{base::length()}} methods are ignored. } \examples{ has_length(list()) has_length(list(), 0) has_length(letters) has_length(letters, 20) has_length(letters, 26) } rlang/man/switch_type.Rd0000644000176200001440000000445213241233650014765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{switch_type} \alias{switch_type} \alias{coerce_type} \alias{switch_class} \alias{coerce_class} \title{Dispatch on base types} \usage{ switch_type(.x, ...) coerce_type(.x, .to, ...) switch_class(.x, ...) coerce_class(.x, .to, ...) } \arguments{ \item{.x}{An object from which to dispatch.} \item{...}{Named clauses. The names should be types as returned by \code{\link[=type_of]{type_of()}}.} \item{.to}{This is useful when you switchpatch within a coercing function. If supplied, this should be a string indicating the target type. A catch-all clause is then added to signal an error stating the conversion failure. This type is prettified unless \code{.to} inherits from the S3 class \code{"AsIs"} (see \code{\link[base:I]{base::I()}}).} } \description{ \code{switch_type()} is equivalent to \code{\link[base]{switch}(\link{type_of}(x, ...))}, while \code{switch_class()} switchpatches based on \code{class(x)}. The \code{coerce_} versions are intended for type conversion and provide a standard error message when conversion fails. } \section{Life cycle}{ \itemize{ \item Like \code{\link[=type_of]{type_of()}}, \code{switch_type()} and \code{coerce_type()} are experimental functions. \item \code{switch_class()} and \code{coerce_class()} are experimental functions. } } \examples{ switch_type(3L, double = "foo", integer = "bar", "default" ) # Use the coerce_ version to get standardised error handling when no # type matches: to_chr <- function(x) { coerce_type(x, "a chr", integer = as.character(x), double = as.character(x) ) } to_chr(3L) # Strings have their own type: switch_type("str", character = "foo", string = "bar", "default" ) # Use a fallthrough clause if you need to dispatch on all character # vectors, including strings: switch_type("str", string = , character = "foo", "default" ) # special and builtin functions are treated as primitive, since # there is usually no reason to treat them differently: switch_type(base::list, primitive = "foo", "default" ) switch_type(base::`$`, primitive = "foo", "default" ) # closures are not primitives: switch_type(rlang::switch_type, primitive = "foo", "default" ) } \seealso{ \code{\link[=switch_lang]{switch_lang()}} } \keyword{internal} rlang/man/is_quosureish.Rd0000644000176200001440000000140413241233650015317 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{is_quosureish} \alias{is_quosureish} \alias{as_quosureish} \title{Test for or coerce to quosure-like objects} \usage{ is_quosureish(x, scoped = NULL) as_quosureish(x, env = caller_env()) } \arguments{ \item{x}{An object to test.} \item{scoped}{A boolean indicating whether the quosure is scoped, that is, has a valid environment attribute. If \code{NULL}, the scope is not inspected.} \item{env}{The original context of the context expression.} } \description{ These functions are deprecated as of rlang 0.2.0 because they make the assumption that quosures are a subtype of formula, which we are now considering to be an implementation detail. } \keyword{internal} rlang/man/is_formula.Rd0000644000176200001440000000320713241233650014560 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formula.R \name{is_formula} \alias{is_formula} \alias{is_bare_formula} \title{Is object a formula?} \usage{ is_formula(x, scoped = NULL, lhs = NULL) is_bare_formula(x, scoped = NULL, lhs = NULL) } \arguments{ \item{x}{An object to test.} \item{scoped}{A boolean indicating whether the quosure is scoped, that is, has a valid environment attribute. If \code{NULL}, the scope is not inspected.} \item{lhs}{A boolean indicating whether the \link[=is_formula]{formula} or \link[=is_definition]{definition} has a left-hand side. If \code{NULL}, the LHS is not inspected.} } \description{ \code{is_formula()} tests if \code{x} is a call to \code{~}. \code{is_bare_formula()} tests in addition that \code{x} does not inherit from anything else than \code{"formula"}. } \details{ The \code{scoped} argument patterns-match on whether the scoped bundled with the quosure is valid or not. Invalid scopes may happen in nested quotations like \code{~~expr}, where the outer quosure is validly scoped but not the inner one. This is because \code{~} saves the environment when it is evaluated, and quoted formulas are by definition not evaluated. } \examples{ x <- disp ~ am is_formula(x) is_formula(~10) is_formula(10) is_formula(quo(foo)) is_bare_formula(quo(foo)) # Note that unevaluated formulas are treated as bare formulas even # though they don't inherit from "formula": f <- quote(~foo) is_bare_formula(f) # However you can specify `scoped` if you need the predicate to # return FALSE for these unevaluated formulas: is_bare_formula(f, scoped = TRUE) is_bare_formula(eval(f), scoped = TRUE) } rlang/man/set_chr_encoding.Rd0000644000176200001440000000555513241233650015725 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-chr.R \name{set_chr_encoding} \alias{set_chr_encoding} \alias{chr_encoding} \alias{set_str_encoding} \alias{str_encoding} \title{Set encoding of a string or character vector} \usage{ set_chr_encoding(x, encoding = c("unknown", "UTF-8", "latin1", "bytes")) chr_encoding(x) set_str_encoding(x, encoding = c("unknown", "UTF-8", "latin1", "bytes")) str_encoding(x) } \arguments{ \item{x}{A string or character vector.} \item{encoding}{Either an encoding specially handled by R (\code{"UTF-8"} or \code{"latin1"}), \code{"bytes"} to inhibit all encoding conversions, or \code{"unknown"} if the string should be treated as encoded in the current locale codeset.} } \description{ R has specific support for UTF-8 and latin1 encoded strings. This mostly matters for internal conversions. Thanks to this support, you can reencode strings to UTF-8 or latin1 for internal processing, and return these strings without having to convert them back to the native encoding. However, it is important to make sure the encoding mark has not been lost in the process, otherwise the output will be treated as if encoded according to the current locale (see \code{\link[=mut_utf8_locale]{mut_utf8_locale()}} for documentation about locale codesets), which is not appropriate if it does not coincide with the actual encoding. In those situations, you can use these functions to ensure an encoding mark in your strings. } \section{Life cycle}{ These functions are experimental. They might be removed in the future because they don't bring anything new over the base API. } \examples{ # Encoding marks are always ignored on ASCII strings: str_encoding(set_str_encoding("cafe", "UTF-8")) # You can specify the encoding of strings containing non-ASCII # characters: cafe <- string(c(0x63, 0x61, 0x66, 0xC3, 0xE9)) str_encoding(cafe) str_encoding(set_str_encoding(cafe, "UTF-8")) # It is important to consistently mark the encoding of strings # because R and other packages perform internal string conversions # all the time. Here is an example with the names attribute: latin1 <- string(c(0x63, 0x61, 0x66, 0xE9), "latin1") latin1 <- set_names(latin1) # The names attribute is encoded in latin1 as we would expect: str_encoding(names(latin1)) # However the names are converted to UTF-8 by the c() function: str_encoding(names(c(latin1))) as_bytes(names(c(latin1))) # Bad things happen when the encoding marker is lost and R performs # a conversion. R will assume that the string is encoded according # to the current locale: \dontrun{ bad <- set_names(set_str_encoding(latin1, "unknown")) mut_utf8_locale() str_encoding(names(c(bad))) as_bytes(names(c(bad))) } } \seealso{ \code{\link[=mut_utf8_locale]{mut_utf8_locale()}} about the effects of the locale, and \code{\link[=as_utf8_string]{as_utf8_string()}} about encoding conversion. } \keyword{internal} rlang/man/caller_env.Rd0000644000176200001440000000061213241233650014527 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.R \name{caller_env} \alias{caller_env} \alias{caller_frame} \alias{caller_fn} \title{Get the environment of the caller frame} \usage{ caller_env(n = 1) caller_frame(n = 1) caller_fn(n = 1) } \arguments{ \item{n}{The number of generation to go back.} } \description{ Get the environment of the caller frame } rlang/man/rst_muffle.Rd0000644000176200001440000000460113241233650014565 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd-restarts.R \name{rst_muffle} \alias{rst_muffle} \title{Jump to a muffling restart} \usage{ rst_muffle(c) } \arguments{ \item{c}{A condition to muffle.} } \description{ Muffle restarts are established at the same location as where a condition is signalled. They are useful for two non-exclusive purposes: muffling signalling functions and muffling conditions. In the first case, \code{rst_muffle()} prevents any further side effects of a signalling function (a warning or message from being displayed, an aborting jump to top level, etc). In the second case, the muffling jump prevents a condition from being passed on to other handlers. In both cases, execution resumes normally from the point where the condition was signalled. } \examples{ side_effect <- function() cat("side effect!\\n") handler <- inplace(function(c) side_effect()) # A muffling handler is an inplace handler that jumps to a muffle # restart: muffling_handler <- inplace(function(c) { side_effect() rst_muffle(c) }) # You can also create a muffling handler simply by setting # muffle = TRUE: muffling_handler <- inplace(function(c) side_effect(), muffle = TRUE) # You can then muffle the signalling function: fn <- function(signal, msg) { signal(msg) "normal return value" } with_handlers(fn(message, "some message"), message = handler) with_handlers(fn(message, "some message"), message = muffling_handler) with_handlers(fn(warning, "some warning"), warning = muffling_handler) # Note that exiting handlers are thrown to the establishing point # before being executed. At that point, the restart (established # within the signalling function) does not exist anymore: \dontrun{ with_handlers(fn(warning, "some warning"), warning = exiting(function(c) rst_muffle(c))) } # Another use case for muffle restarts is to muffle conditions # themselves. That is, to prevent other condition handlers from # being called: undesirable_handler <- inplace(function(c) cat("please don't call me\\n")) with_handlers(foo = undesirable_handler, with_handlers(foo = muffling_handler, { cnd_signal("foo", mufflable = TRUE) "return value" })) # See the `mufflable` argument of cnd_signal() for more on this point } \seealso{ The \code{muffle} argument of \code{\link[=inplace]{inplace()}}, and the \code{mufflable} argument of \code{\link[=cnd_signal]{cnd_signal()}}. } rlang/man/env_depth.Rd0000644000176200001440000000140713241233650014374 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{env_depth} \alias{env_depth} \title{Depth of an environment chain} \usage{ env_depth(env) } \arguments{ \item{env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}.} } \value{ An integer. } \description{ This function returns the number of environments between \code{env} and the \link[=empty_env]{empty environment}, including \code{env}. The depth of \code{env} is also the number of parents of \code{env} (since the empty environment counts as a parent). } \examples{ env_depth(empty_env()) env_depth(pkg_env("rlang")) } \seealso{ The section on inheritance in \code{\link[=env]{env()}} documentation. } rlang/man/prim_name.Rd0000644000176200001440000000047313241233650014371 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fn.R \name{prim_name} \alias{prim_name} \title{Name of a primitive function} \usage{ prim_name(prim) } \arguments{ \item{prim}{A primitive function such as \code{\link[base:c]{base::c()}}.} } \description{ Name of a primitive function } rlang/man/as_env.Rd0000644000176200001440000000053413241233650013673 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{as_env} \alias{as_env} \title{Coerce to an environment} \usage{ as_env(x, parent = NULL) } \description{ This function is soft-deprecated as it was renamed to \code{\link[=as_environment]{as_environment()}} in rlang 0.2.0. } \keyword{internal} rlang/man/quo_squash.Rd0000644000176200001440000000317013241233650014607 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/quo.R \name{quo_squash} \alias{quo_squash} \title{Squash a quosure} \usage{ quo_squash(quo, warn = FALSE) } \arguments{ \item{quo}{A quosure or expression.} \item{warn}{Whether to warn if the quosure contains other quosures (those will be collapsed). This is useful when you use \code{quo_squash()} in order to make a non-tidyeval API compatible with quosures. In that case, getting rid of the nested quosures is likely to cause subtle bugs and it is good practice to warn the user about it.} } \description{ \code{quo_squash()} flattens all nested quosures within an expression. For example it transforms \code{^foo(^bar(), ^baz)} to the bare expression \code{foo(bar(), baz)}. This operation is safe if the squashed quosure is used for labelling or printing (see \code{\link[=quo_label]{quo_label()}} or \code{\link[=quo_name]{quo_name()}}). However if the squashed quosure is evaluated, all expressions of the flattened quosures are resolved in a single environment. This is a source of bugs so it is good practice to set \code{warn} to \code{TRUE} to let the user know about the lossy squashing. } \section{Life cycle}{ This function replaces \code{quo_expr()} which was soft-deprecated in rlang 0.2.0. \code{quo_expr()} was a misnomer because it implied that it was a mere expression acccessor for quosures whereas it was really a lossy operation that squashed all nested quosures. } \examples{ # Quosures can contain nested quosures: quo <- quo(wrapper(!!quo(wrappee))) quo # quo_squash() flattens all the quosures and returns a simple expression: quo_squash(quo) } rlang/man/duplicate.Rd0000644000176200001440000000237213241233650014374 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sexp.R \name{duplicate} \alias{duplicate} \title{Duplicate an R object} \usage{ duplicate(x, shallow = FALSE) } \arguments{ \item{x}{Any R object. However, uncopyable types like symbols and environments are returned as is (just like with \code{<-}).} \item{shallow}{This is relevant for recursive data structures like lists, calls and pairlists. A shallow copy only duplicates the top-level data structure. The objects contained in the list are still the same.} } \description{ In R semantics, objects are copied by value. This means that modifying the copy leaves the original object intact. Since, copying data in memory is an expensive operation, copies in R are as lazy as possible. They only happen when the new object is actually modified. However, some operations (like \code{\link[=node_poke_car]{node_poke_car()}} or \code{\link[=node_poke_cdr]{node_poke_cdr()}}) do not support copy-on-write. In those cases, it is necessary to duplicate the object manually in order to preserve copy-by-value semantics. } \details{ Some objects are not duplicable, like symbols and environments. \code{duplicate()} returns its input for these unique objects. } \seealso{ pairlist } \keyword{internal} rlang/man/scoped_env.Rd0000644000176200001440000000634313241233650014551 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{scoped_env} \alias{scoped_env} \alias{pkg_env} \alias{pkg_env_name} \alias{scoped_names} \alias{scoped_envs} \alias{is_scoped} \alias{base_env} \alias{global_env} \title{Scoped environments} \usage{ scoped_env(nm) pkg_env(pkg) pkg_env_name(pkg) scoped_names() scoped_envs() is_scoped(nm) base_env() global_env() } \arguments{ \item{nm}{The name of an environment attached to the search path. Call \code{\link[base:search]{base::search()}} to see what is currently on the path.} \item{pkg}{The name of a package.} } \description{ Scoped environments are named environments which form a parent-child hierarchy called the search path. They define what objects you can see (are in scope) from your workspace. They typically are package environments, i.e. special environments containing all exported functions from a package (and whose parent environment is the package namespace, which also contains unexported functions). Package environments are attached to the search path with \code{\link[base:library]{base::library()}}. Note however that any environment can be attached to the search path, for example with the unrecommended \code{\link[base:attach]{base::attach()}} base function which transforms vectors to scoped environments. \itemize{ \item You can list all scoped environments with \code{scoped_names()}. Unlike \code{\link[base:search]{base::search()}}, it also mentions the empty environment that terminates the search path (it is given the name \code{"NULL"}). \item \code{scoped_envs()} returns all environments on the search path, including the empty environment. \item \code{pkg_env()} takes a package name and returns the scoped environment of packages if they are attached to the search path, and throws an error otherwise. \item \code{is_scoped()} allows you to check whether a named environment is on the search path. } } \section{Search path}{ The search path is a chain of scoped environments where newly attached environments are the childs of earlier ones. However, the global environment, where everything you define at top-level ends up, is pinned as the head of that linked chain. Likewise, the base package environment is pinned as the tail of the chain. You can retrieve those environments with \code{global_env()} and \code{base_env()} respectively. The global environment is also the environment of the very first evaluation frame on the stack, see \code{\link[=global_frame]{global_frame()}} and \code{\link[=ctxt_stack]{ctxt_stack()}}. } \section{Life cycle}{ These functions are experimental and may not belong to the rlang package. Expect API changes. } \examples{ # List the names of scoped environments: nms <- scoped_names() nms # The global environment is always the first in the chain: scoped_env(nms[[1]]) # And the scoped environment of the base package is always the last: scoped_env(nms[[length(nms)]]) # These two environments have their own shortcuts: global_env() base_env() # Packages appear in the search path with a special name. Use # pkg_env_name() to create that name: pkg_env_name("rlang") scoped_env(pkg_env_name("rlang")) # Alternatively, get the scoped environment of a package with # pkg_env(): pkg_env("utils") } \keyword{internal} rlang/man/lifecycle.Rd0000644000176200001440000001651013241233650014360 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle.R \name{lifecycle} \alias{lifecycle} \title{Life cycle of the rlang package} \description{ The rlang package is currently maturing. Unless otherwise stated, this applies to all its exported functions. Maturing functions are susceptible to API changes. Only use these in packages if you're prepared to make changes as the package evolves. See sections below for a list of functions marked as stable. The documentation pages of retired functions contain life cycle sections that explain the reasons for their retirements. } \section{Stable functions}{ \itemize{ \item \code{\link[=eval_tidy]{eval_tidy()}} \item \link{!!}, \link{!!!} \item \code{\link[=enquo]{enquo()}}, \code{\link[=quo]{quo()}}, \code{\link[=quos]{quos()}} \item \code{\link[=enexpr]{enexpr()}}, \code{\link[=expr]{expr()}}, \code{\link[=exprs]{exprs()}} \item \code{\link[=sym]{sym()}}, \code{\link[=syms]{syms()}} \item \code{\link[=new_quosure]{new_quosure()}}, \code{\link[=is_quosure]{is_quosure()}} \item \code{\link[=missing_arg]{missing_arg()}}, \code{\link[=is_missing]{is_missing()}} \item \code{\link[=quo_get_expr]{quo_get_expr()}}, \code{\link[=quo_set_expr]{quo_set_expr()}} \item \code{\link[=quo_get_env]{quo_get_env()}}, \code{\link[=quo_set_env]{quo_set_env()}} \item \code{\link[=eval_bare]{eval_bare()}} \item \code{\link[=set_names]{set_names()}}, \code{\link[=names2]{names2()}} \item \code{\link[=as_function]{as_function()}} } } \section{Experimental functions}{ These functions are not yet part of the rlang API. Expect breaking changes. \itemize{ \item \code{\link[=type_of]{type_of()}}, \code{\link[=switch_type]{switch_type()}}, \code{\link[=coerce_type]{coerce_type()}} \item \code{\link[=switch_class]{switch_class()}}, \code{\link[=coerce_class]{coerce_class()}} \item \code{\link[=lang_type_of]{lang_type_of()}}, \code{\link[=switch_lang]{switch_lang()}}, \code{\link[=coerce_lang]{coerce_lang()}} \item \code{\link[=set_attrs]{set_attrs()}}, \code{\link[=mut_attrs]{mut_attrs()}} \item \code{\link[=with_env]{with_env()}}, \code{\link[=locally]{locally()}} \item \code{\link[=env_poke]{env_poke()}} \item \code{\link[=env_bind_fns]{env_bind_fns()}}, \code{\link[=env_bind_exprs]{env_bind_exprs()}} \item \code{\link[=pkg_env]{pkg_env()}}, \code{\link[=pkg_env_name]{pkg_env_name()}} \item \code{\link[=scoped_env]{scoped_env()}}, \code{\link[=scoped_names]{scoped_names()}}, \code{\link[=scoped_envs]{scoped_envs()}}, \code{\link[=is_scoped]{is_scoped()}} \item \code{\link[=ns_env]{ns_env()}}, \code{\link[=ns_imports_env]{ns_imports_env()}}, \code{\link[=ns_env_name]{ns_env_name()}} \item \code{\link[=is_pairlist]{is_pairlist()}}, \code{\link[=as_pairlist]{as_pairlist()}}, \code{\link[=is_node]{is_node()}}, \code{\link[=is_node_list]{is_node_list()}} \item \code{\link[=is_definition]{is_definition()}}, \code{\link[=new_definition]{new_definition()}}, \code{\link[=is_formulaish]{is_formulaish()}}, \code{\link[=dots_definitions]{dots_definitions()}} \item \code{\link[=scoped_options]{scoped_options()}}, \code{\link[=with_options]{with_options()}}, \code{\link[=push_options]{push_options()}}, \code{\link[=peek_options]{peek_options()}}, \code{\link[=peek_option]{peek_option()}} \item \code{\link[=as_bytes]{as_bytes()}}, \code{\link[=chr_unserialise_unicode]{chr_unserialise_unicode()}}, \code{\link[=set_chr_encoding]{set_chr_encoding()}}, \code{\link[=chr_encoding]{chr_encoding()}}, \code{\link[=set_str_encoding]{set_str_encoding()}}, \code{\link[=str_encoding]{str_encoding()}} \item \code{\link[=mut_utf8_locale]{mut_utf8_locale()}}, \code{\link[=mut_latin1_locale]{mut_latin1_locale()}}, \code{\link[=mut_mbcs_locale]{mut_mbcs_locale()}} \item \code{\link[=prepend]{prepend()}}, \code{\link[=modify]{modify()}} } } \section{Questioning functions}{ \itemize{ \item \code{\link[=UQ]{UQ()}}, \code{\link[=UQS]{UQS()}} \item \code{\link[=dots_splice]{dots_splice()}}, \code{\link[=splice]{splice()}} \item \code{\link[=invoke]{invoke()}} \item \code{\link[=is_frame]{is_frame()}}, \code{\link[=global_frame]{global_frame()}}, \code{\link[=current_frame]{current_frame()}}, \code{\link[=ctxt_frame]{ctxt_frame()}}, \code{\link[=call_frame]{call_frame()}}, \code{\link[=frame_position]{frame_position()}} \item \code{\link[=ctxt_depth]{ctxt_depth()}}, \code{\link[=call_depth]{call_depth()}}, \code{\link[=ctxt_stack]{ctxt_stack()}}, \code{\link[=call_stack]{call_stack()}}, \code{\link[=stack_trim]{stack_trim()}} } } \section{Soft-deprecated functions and arguments}{ \strong{Retired in rlang 0.2.0:} \itemize{ \item \code{\link[=eval_tidy_]{eval_tidy_()}} \item \code{\link[=overscope_clean]{overscope_clean()}} \item \code{\link[=overscope_eval_next]{overscope_eval_next()}} => \code{\link[=eval_tidy]{eval_tidy()}} \item \code{\link[=lang_head]{lang_head()}}, \code{\link[=lang_tail]{lang_tail()}} } \strong{Renamed in rlang 0.2.0:} \itemize{ \item \code{\link[=quo_expr]{quo_expr()}} => \code{\link[=quo_squash]{quo_squash()}} \item \code{\link[=parse_quosure]{parse_quosure()}} => \code{\link[=parse_quo]{parse_quo()}} \item \code{\link[=parse_quosures]{parse_quosures()}} => \code{\link[=parse_quos]{parse_quos()}} \item \code{\link[=as_overscope]{as_overscope()}} => \code{\link[=as_data_mask]{as_data_mask()}} \item \code{\link[=new_overscope]{new_overscope()}} => \code{\link[=new_data_mask]{new_data_mask()}} \item \code{\link[=as_dictionary]{as_dictionary()}} => \code{\link[=as_data_pronoun]{as_data_pronoun()}} \item \code{\link[=lang]{lang()}} => \code{\link[=call2]{call2()}} \item \code{\link[=new_language]{new_language()}} => \code{\link[=new_call]{new_call()}} \item \code{\link[=is_lang]{is_lang()}} => \code{\link[=is_call]{is_call()}} \item \code{\link[=is_unary_lang]{is_unary_lang()}} => Use the \code{n} argument of \code{\link[=is_call]{is_call()}} \item \code{\link[=is_binary_lang]{is_binary_lang()}} => Use the \code{n} argument of \code{\link[=is_call]{is_call()}} \item \code{\link[=quo_is_lang]{quo_is_lang()}} => \code{\link[=quo_is_call]{quo_is_call()}} \item \code{\link[=is_expr]{is_expr()}} => \code{\link[=is_expression]{is_expression()}} \item \code{\link[=lang_modify]{lang_modify()}} => \code{\link[=call_modify]{call_modify()}} \item \code{\link[=lang_standardise]{lang_standardise()}} => \code{\link[=call_standardise]{call_standardise()}} \item \code{\link[=lang_fn]{lang_fn()}} => \code{\link[=call_fn]{call_fn()}} \item \code{\link[=lang_name]{lang_name()}} => \code{\link[=call_name]{call_name()}} \item \code{\link[=lang_args]{lang_args()}} => \code{\link[=call_args]{call_args()}} \item \code{\link[=lang_args_names]{lang_args_names()}} => \code{\link[=call_args_names]{call_args_names()}} } } \section{Deprecated functions and arguments}{ \strong{Retired in rlang 0.2.0:} \itemize{ \item \code{\link[=UQE]{UQE()}} \item \code{\link[=is_quosureish]{is_quosureish()}}, \code{\link[=as_quosureish]{as_quosureish()}} } \strong{Renamed in rlang 0.2.0} \itemize{ \item \code{\link[=new_cnd]{new_cnd()}} => \code{\link[=cnd]{cnd()}} \item \code{\link[=cnd_message]{cnd_message()}} => \code{\link[=message_cnd]{message_cnd()}} \item \code{\link[=cnd_warning]{cnd_warning()}} => \code{\link[=warning_cnd]{warning_cnd()}} \item \code{\link[=cnd_error]{cnd_error()}} => \code{\link[=error_cnd]{error_cnd()}} } } \section{Defunct functions and arguments}{ \strong{Retired in rlang 0.2.0:} \itemize{ \item \link[=quasiquotation]{:=} } } rlang/man/fn_fmls.Rd0000644000176200001440000000417613241233650014052 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fn.R \name{fn_fmls} \alias{fn_fmls} \alias{fn_fmls_names} \alias{fn_fmls_syms} \alias{fn_fmls<-} \alias{fn_fmls_names<-} \title{Extract arguments from a function} \usage{ fn_fmls(fn = caller_fn()) fn_fmls_names(fn = caller_fn()) fn_fmls_syms(fn = caller_fn()) fn_fmls(fn) <- value fn_fmls_names(fn) <- value } \arguments{ \item{fn}{A function. It is lookep up in the calling frame if not supplied.} \item{value}{New formals or formals names for \code{fn}.} } \description{ \code{fn_fmls()} returns a named list of formal arguments. \code{fn_fmls_names()} returns the names of the arguments. \code{fn_fmls_syms()} returns formals as a named list of symbols. This is especially useful for forwarding arguments in \link[=lang]{constructed calls}. } \details{ Unlike \code{formals()}, these helpers also work with primitive functions. See \code{\link[=is_function]{is_function()}} for a discussion of primitive and closure functions. Note that the argument names are taken from the closures that are created when passing the primitive to \code{\link[=as_closure]{as_closure()}}. For instance, while the arguments of the primitive operator \code{+} are labelled \code{e1} and \code{e2}, \code{fn_fmls_names()} will return \code{.x} and \code{.y}. Note that for many primitives the base R argument names are purely placeholders since they don't perform regular argument matching. E.g. this returns \code{5} instead of \code{-5}:\preformatted{`-`(e2 = 10, 5) } To regularise the semantics of primitive functions, it is usually a good idea to coerce them to a closure first:\preformatted{minus <- as_closure(`-`) minus(.y = 10, 5) } } \examples{ # Extract from current call: fn <- function(a = 1, b = 2) fn_fmls() fn() # Works with primitive functions: fn_fmls(base::switch) # fn_fmls_syms() makes it easy to forward arguments: call2("apply", !!! fn_fmls_syms(lapply)) # You can also change the formals: fn_fmls(fn) <- list(A = 10, B = 20) fn() fn_fmls_names(fn) <- c("foo", "bar") fn() } \seealso{ \code{\link[=call_args]{call_args()}} and \code{\link[=call_args_names]{call_args_names()}} } rlang/man/arg_match.Rd0000644000176200001440000000157113241233650014347 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/arg.R \name{arg_match} \alias{arg_match} \title{Match an argument to a character vector} \usage{ arg_match(arg, values = NULL) } \arguments{ \item{arg}{A symbol referring to an argument accepting strings.} \item{values}{The possible values that \code{arg} can take. If \code{NULL}, the values are taken from the function definition of the \link[=caller_frame]{caller frame}.} } \value{ The string supplied to \code{arg}. } \description{ This is equivalent to \code{\link[base:match.arg]{base::match.arg()}} with a few differences: \itemize{ \item Partial matches trigger an error. \item Error messages are a bit more informative and obey the tidyverse standards. } } \examples{ fn <- function(x = c("foo", "bar")) arg_match(x) fn("bar") # This would throw an informative error if run: # fn("b") # fn("baz") } rlang/man/expr_label.Rd0000644000176200001440000000207113241233650014533 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/expr.R \name{expr_label} \alias{expr_label} \alias{expr_name} \alias{expr_text} \title{Turn an expression to a label} \usage{ expr_label(expr) expr_name(expr) expr_text(expr, width = 60L, nlines = Inf) } \arguments{ \item{expr}{An expression to labellise.} \item{width}{Width of each line.} \item{nlines}{Maximum number of lines to extract.} } \description{ \code{expr_text()} turns the expression into a single string, which might be multi-line. \code{expr_name()} is suitable for formatting names. It works best with symbols and scalar types, but also accepts calls. \code{expr_label()} formats the expression nicely for use in messages. } \examples{ # To labellise a function argument, first capture it with # substitute(): fn <- function(x) expr_label(substitute(x)) fn(x:y) # Strings are encoded expr_label("a\\nb") # Names and expressions are quoted with `` expr_label(quote(x)) expr_label(quote(a + b + c)) # Long expressions are collapsed expr_label(quote(foo({ 1 + 2 print(x) }))) } rlang/man/new_formula.Rd0000644000176200001440000000074413241233650014741 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formula.R \name{new_formula} \alias{new_formula} \title{Create a formula} \usage{ new_formula(lhs, rhs, env = caller_env()) } \arguments{ \item{lhs, rhs}{A call, name, or atomic vector.} \item{env}{An environment.} } \value{ A formula object. } \description{ Create a formula } \examples{ new_formula(quote(a), quote(b)) new_formula(NULL, quote(b)) } \seealso{ \code{\link[=new_quosure]{new_quosure()}} } rlang/man/catch_cnd.Rd0000644000176200001440000000115713241233650014330 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd.R \name{catch_cnd} \alias{catch_cnd} \title{Catch a condition} \usage{ catch_cnd(expr) } \arguments{ \item{expr}{Expression to be evaluated with a catch-all condition handler.} } \value{ A condition if any was signalled, \code{NULL} otherwise. } \description{ This is a small wrapper around \code{tryCatch()} that captures any condition signalled while evaluating its argument. It is useful for debugging and unit testing. } \examples{ catch_cnd(10) catch_cnd(abort("an error")) catch_cnd(cnd_signal("my_condition", .msg = "a condition")) } rlang/man/parse_quosure.Rd0000644000176200001440000000205313241263002015305 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lifecycle-retired.R \name{parse_quosure} \alias{parse_quosure} \title{Parse text into a quosure} \usage{ parse_quosure(x, env = caller_env()) } \arguments{ \item{x}{Text containing expressions to parse_expr for \code{parse_expr()} and \code{parse_exprs()}. Can also be an R connection, for instance to a file. If the supplied connection is not open, it will be automatically closed and destroyed.} \item{env}{The environment for the quosures. Depending on the use case, a good default might be the \link[=global_env]{global environment} but you might also want to evaluate the R code in an isolated context (perhaps a child of the global environment or of the \link[=base_env]{base environment}).} } \description{ These functions were soft-deprecated and renamed to \code{\link[=parse_quo]{parse_quo()}} and \code{\link[=parse_quos]{parse_quos()}} in rlang 0.2.0. This is for consistency with the convention that suffixes indicating return types are not abbreviated. } \keyword{internal} rlang/man/with_restarts.Rd0000644000176200001440000000766513241305652015340 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd-restarts.R \name{with_restarts} \alias{with_restarts} \title{Establish a restart point on the stack} \usage{ with_restarts(.expr, ...) } \arguments{ \item{.expr}{An expression to execute with new restarts established on the stack. This argument is passed by expression and supports \link[=quasiquotation]{unquoting}. It is evaluated in a context where restarts are established.} \item{...}{Named restart functions. The name is taken as the restart name and the function is executed after the jump. These dots support \link[=tidy-dots]{tidy dots} features.} } \description{ Restart points are named functions that are established with \code{with_restarts()}. Once established, you can interrupt the normal execution of R code, jump to the restart, and resume execution from there. Each restart is established along with a restart function that is executed after the jump and that provides a return value from the establishing point (i.e., a return value for \code{with_restarts()}). } \details{ Restarts are not the only way of jumping to a previous call frame (see \code{\link[=return_from]{return_from()}} or \code{\link[=return_to]{return_to()}}). However, they have the advantage of being callable by name once established. } \examples{ # Restarts are not the only way to jump to a previous frame, but # they have the advantage of being callable by name: fn <- function() with_restarts(g(), my_restart = function() "returned") g <- function() h() h <- function() { rst_jump("my_restart"); "not returned" } fn() # Whereas a non-local return requires to manually pass the calling # frame to the return function: fn <- function() g(get_env()) g <- function(env) h(env) h <- function(env) { return_from(env, "returned"); "not returned" } fn() # rst_maybe_jump() checks that a restart exists before trying to jump: fn <- function() { g() cat("will this be called?\\n") } g <- function() { rst_maybe_jump("my_restart") cat("will this be called?\\n") } # Here no restart are on the stack: fn() # If a restart point called `my_restart` was established on the # stack before calling fn(), the control flow will jump there: rst <- function() { cat("restarting...\\n") "return value" } with_restarts(fn(), my_restart = rst) # Restarts are particularly useful to provide alternative default # values when the normal output cannot be computed: fn <- function(valid_input) { if (valid_input) { return("normal value") } # We decide to return the empty string "" as default value. An # altenative strategy would be to signal an error. In any case, # we want to provide a way for the caller to get a different # output. For this purpose, we provide two restart functions that # returns alternative defaults: restarts <- list( rst_empty_chr = function() character(0), rst_null = function() NULL ) with_restarts(splice(restarts), .expr = { # Signal a typed condition to let the caller know that we are # about to return an empty string as default value: cnd_signal("default_empty_string") # If no jump to with_restarts, return default value: "" }) } # Normal value for valid input: fn(TRUE) # Default value for bad input: fn(FALSE) # Change the default value if you need an empty character vector by # defining an inplace handler that jumps to the restart. It has to # be inplace because exiting handlers jump to the place where they # are established before being executed, and the restart is not # defined anymore at that point: rst_handler <- inplace(function(c) rst_jump("rst_empty_chr")) with_handlers(fn(FALSE), default_empty_string = rst_handler) # You can use restarting() to create restarting handlers easily: with_handlers(fn(FALSE), default_empty_string = restarting("rst_null")) } \seealso{ \code{\link[=return_from]{return_from()}} and \code{\link[=return_to]{return_to()}} for a more flexible way of performing a non-local jump to an arbitrary call frame. } rlang/man/with_handlers.Rd0000644000176200001440000000717613241304332015260 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd-handlers.R \name{with_handlers} \alias{with_handlers} \title{Establish handlers on the stack} \usage{ with_handlers(.expr, ...) } \arguments{ \item{.expr}{An expression to execute in a context where new handlers are established. The underscored version takes a quoted expression or a quoted formula.} \item{...}{Named handlers. Handlers should inherit from \code{exiting} or \code{inplace}. See \code{\link[=exiting]{exiting()}} and \code{\link[=inplace]{inplace()}} for constructing such handlers. Dots are evaluated with \link[=tidy-dots]{explicit splicing}.} } \description{ Condition handlers are functions established on the evaluation stack (see \code{\link[=ctxt_stack]{ctxt_stack()}}) that are called by R when a condition is signalled (see \code{\link[=cnd_signal]{cnd_signal()}} and \code{\link[=abort]{abort()}} for two common signal functions). They come in two types: exiting handlers, which jump out of the signalling context and are transferred to \code{with_handlers()} before being executed. And inplace handlers, which are executed within the signal functions. } \details{ An exiting handler is taking charge of the condition. No other handler on the stack gets a chance to handle the condition. The handler is executed and \code{with_handlers()} returns the return value of that handler. On the other hand, in place handlers do not necessarily take charge. If they return normally, they decline to handle the condition, and R looks for other handlers established on the evaluation stack. Only by jumping to an earlier call frame can an inplace handler take charge of the condition and stop the signalling process. Sometimes, a muffling restart has been established for the purpose of jumping out of the signalling function but not out of the context where the condition was signalled, which allows execution to resume normally. See \code{\link[=rst_muffle]{rst_muffle()}} the \code{muffle} argument of \code{\link[=inplace]{inplace()}} and the \code{mufflable} argument of \code{\link[=cnd_signal]{cnd_signal()}}. Exiting handlers are established first by \code{with_handlers()}, and in place handlers are installed in second place. The latter handlers thus take precedence over the former. } \examples{ # Signal a condition with cnd_signal(): fn <- function() { g() cat("called?\\n") "fn() return value" } g <- function() { h() cat("called?\\n") } h <- function() { cnd_signal("foo") cat("called?\\n") } # Exiting handlers jump to with_handlers() before being # executed. Their return value is handed over: handler <- function(c) "handler return value" with_handlers(fn(), foo = exiting(handler)) # In place handlers are called in turn and their return value is # ignored. Returning just means they are declining to take charge of # the condition. However, they can produce side-effects such as # displaying a message: some_handler <- function(c) cat("some handler!\\n") other_handler <- function(c) cat("other handler!\\n") with_handlers(fn(), foo = inplace(some_handler), foo = inplace(other_handler)) # If an in place handler jumps to an earlier context, it takes # charge of the condition and no other handler gets a chance to # deal with it. The canonical way of transferring control is by # jumping to a restart. See with_restarts() and restarting() # documentation for more on this: exiting_handler <- function(c) rst_jump("rst_foo") fn2 <- function() { with_restarts(g(), rst_foo = function() "restart value") } with_handlers(fn2(), foo = inplace(exiting_handler), foo = inplace(other_handler)) } \seealso{ \code{\link[=exiting]{exiting()}}, \code{\link[=inplace]{inplace()}}. } rlang/man/scalar-type-predicates.Rd0000644000176200001440000000176413241233650016773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R \name{scalar-type-predicates} \alias{scalar-type-predicates} \alias{is_scalar_list} \alias{is_scalar_atomic} \alias{is_scalar_vector} \alias{is_scalar_integer} \alias{is_scalar_double} \alias{is_scalar_character} \alias{is_scalar_logical} \alias{is_scalar_raw} \alias{is_string} \alias{is_scalar_bytes} \title{Scalar type predicates} \usage{ is_scalar_list(x) is_scalar_atomic(x) is_scalar_vector(x) is_scalar_integer(x) is_scalar_double(x) is_scalar_character(x, encoding = NULL) is_scalar_logical(x) is_scalar_raw(x) is_string(x, encoding = NULL) is_scalar_bytes(x) } \arguments{ \item{x}{object to be tested.} \item{encoding}{Expected encoding of a string or character vector. One of \code{UTF-8}, \code{latin1}, or \code{unknown}.} } \description{ These predicates check for a given type and whether the vector is "scalar", that is, of length 1. } \seealso{ \link{type-predicates}, \link{bare-type-predicates} } rlang/man/scoped_bindings.Rd0000644000176200001440000000326413241233650015555 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{scoped_bindings} \alias{scoped_bindings} \alias{with_bindings} \title{Temporarily change bindings of an environment} \usage{ scoped_bindings(..., .env = .frame, .frame = caller_env()) with_bindings(.expr, ..., .env = caller_env()) } \arguments{ \item{...}{Pairs of names and values. These dots support splicing (with value semantics) and name unquoting.} \item{.env}{An environment or an object bundling an environment, e.g. a formula, \link[=quotation]{quosure} or \link[=is_closure]{closure}. This argument is passed to \code{\link[=get_env]{get_env()}}.} \item{.frame}{The frame environment that determines the scope of the temporary bindings. When that frame is popped from the call stack, bindings are switched back to their original values.} \item{.expr}{An expression to evaluate with temporary bindings.} } \value{ \code{scoped_bindings()} returns the values of old bindings invisibly; \code{with_bindings()} returns the value of \code{expr}. } \description{ \itemize{ \item \code{scoped_bindings()} temporarily changes bindings in \code{.env} (which is by default the caller environment). The bindings are reset to their original values when the current frame (or an arbitrary one if you specify \code{.frame}) goes out of scope. \item \code{with_bindings()} evaluates \code{expr} with temporary bindings. When \code{with_bindings()} returns, bindings are reset to their original values. It is a simple wrapper around \code{scoped_bindings()}. } } \examples{ foo <- "foo" bar <- "bar" # `foo` will be temporarily rebinded while executing `expr` with_bindings(paste(foo, bar), foo = "rebinded") paste(foo, bar) } rlang/man/scoped_options.Rd0000644000176200001440000000422213241233650015446 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/state.R \name{scoped_options} \alias{scoped_options} \alias{with_options} \alias{push_options} \alias{peek_options} \alias{peek_option} \title{Change global options} \usage{ scoped_options(..., .frame = caller_env()) with_options(.expr, ...) push_options(...) peek_options(...) peek_option(name) } \arguments{ \item{...}{For \code{scoped_options()} and \code{push_options()}, named values defining new option values. For \code{peek_options()}, strings or character vectors of option names.} \item{.frame}{The environment of a stack frame which defines the scope of the temporary options. When the frame returns, the options are set back to their original values.} \item{.expr}{An expression to evaluate with temporary options.} \item{name}{An option name as string.} } \value{ For \code{scoped_options()} and \code{push_options()}, the old option values. \code{peek_option()} returns the current value of an option while the plural \code{peek_options()} returns a list of current option values. } \description{ \itemize{ \item \code{scoped_options()} changes options for the duration of a stack frame (by default the current one). Options are set back to their old values when the frame returns. \item \code{with_options()} changes options while an expression is evaluated. Options are restored when the expression returns. \item \code{push_options()} adds or changes options permanently. \item \code{peek_option()} and \code{peek_options()} return option values. The former returns the option directly while the latter returns a list. } } \section{Life cycle}{ These functions are experimental. } \examples{ # Store and retrieve a global option: push_options(my_option = 10) peek_option("my_option") # Change the option temporarily: with_options(my_option = 100, peek_option("my_option")) peek_option("my_option") # The scoped variant is useful within functions: fn <- function() { scoped_options(my_option = 100) peek_option("my_option") } fn() peek_option("my_option") # The plural peek returns a named list: peek_options("my_option") peek_options("my_option", "digits") } \keyword{experimental} rlang/man/vector-construction.Rd0000644000176200001440000000400013242734207016447 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vec-new.R \name{vector-construction} \alias{vector-construction} \alias{lgl} \alias{int} \alias{dbl} \alias{cpl} \alias{chr} \alias{bytes} \alias{ll} \title{Create vectors} \usage{ lgl(...) int(...) dbl(...) cpl(...) chr(..., .encoding = NULL) bytes(...) ll(...) } \arguments{ \item{...}{Components of the new vector. Bare lists and explicitly spliced lists are spliced.} \item{.encoding}{If non-null, passed to \code{\link[=set_chr_encoding]{set_chr_encoding()}} to add an encoding mark. This is only declarative, no encoding conversion is performed.} } \description{ The atomic vector constructors are equivalent to \code{\link[=c]{c()}} but: \itemize{ \item They allow you to be more explicit about the output type. Implicit coercions (e.g. from integer to logical) follow the rules described in \link{vector-coercion}. \item They use \link[=tidy-dots]{tidy dots} and thus support splicing with \code{!!!}. } } \section{Life cycle}{ \itemize{ \item Automatic splicing is soft-deprecated and will trigger a warning in a future version. Please splice explicitly with \code{!!!}. } } \examples{ # These constructors are like a typed version of c(): c(TRUE, FALSE) lgl(TRUE, FALSE) # They follow a restricted set of coercion rules: int(TRUE, FALSE, 20) # Lists can be spliced: dbl(10, !!! list(1, 2L), TRUE) # They splice names a bit differently than c(). The latter # automatically composes inner and outer names: c(a = c(A = 10), b = c(B = 20, C = 30)) # On the other hand, rlang's ctors use the inner names and issue a # warning to inform the user that the outer names are ignored: dbl(a = c(A = 10), b = c(B = 20, C = 30)) dbl(a = c(1, 2)) # As an exception, it is allowed to provide an outer name when the # inner vector is an unnamed scalar atomic: dbl(a = 1) # Spliced lists behave the same way: dbl(!!! list(a = 1)) dbl(!!! list(a = c(A = 1))) # bytes() accepts integerish inputs bytes(1:10) bytes(0x01, 0xff, c(0x03, 0x05), list(10, 20, 30L)) }