Compatibility with R 4.6

crates/ark/src/lsp/completions/completion_item.rs

@@ -19,7 +19,6 @@ use harp::utils::r_typeof;
 use libr::R_UnboundValue;
 use libr::Rf_findVarInFrame;
 use libr::Rf_isFunction;
-use libr::ENCLOS;
 use libr::PROMSXP;
 use libr::PRVALUE;
 use libr::SEXP;
@@ -480,7 +479,7 @@ pub(super) unsafe fn completion_item_from_namespace(
     };
 
     // Otherwise, try the imports environment.
-    let imports = ENCLOS(namespace);
+    let imports = harp::env_parent(namespace);
     let error_imports = match completion_item_from_symbol(
         name,
         imports,

crates/ark/src/lsp/completions/sources/composite/search_path.rs

@@ -5,6 +5,7 @@
 //
 //
 
+use harp::env_parent;
 use harp::exec::RFunction;
 use harp::exec::RFunctionExt;
 use harp::utils::r_env_is_pkg_env;
@@ -14,7 +15,6 @@ use harp::vector::Vector;
 use harp::RObject;
 use libr::R_EmptyEnv;
 use libr::R_lsInternal;
-use libr::ENCLOS;
 use tower_lsp::lsp_types::CompletionItem;
 
 use crate::console;
@@ -113,7 +113,7 @@ fn completions_from_search_path(
             }
 
             // Get the next environment.
-            env = ENCLOS(env);
+            env = env_parent(env);
         }
 
         // Include installed packages as well.

crates/ark/src/modules.rs

@@ -6,7 +6,6 @@
 //
 
 use anyhow::anyhow;
-use harp::environment::Environment;
 use harp::environment::R_ENVS;
 use harp::exec::RFunction;
 use harp::exec::RFunctionExt;
@@ -92,12 +91,6 @@ pub fn initialize() -> anyhow::Result<RObject> {
         Ok(harp::source_str_in(source, namespace.sexp)?)
     })?;
 
-    // Lock the environment. It will be unlocked automatically when updating.
-    // Needs to happen after the `r_source_in()` above. We don't lock the
-    // bindings to make it easy to make updates by `source()`ing inside the
-    // temporarily unlocked environment.
-    Environment::view(namespace.sexp).lock(false);
-
     // Load the positron and rstudio namespaces and their exported functions
     for file in PositronModuleAsset::iter() {
         source_asset::<PositronModuleAsset>(&file, "import_positron", namespace.sexp)?;
@@ -158,6 +151,11 @@ pub fn initialize() -> anyhow::Result<RObject> {
     let init = RFunction::from("initialize_errors");
     unsafe { libr::Rf_eval(init.call.build().sexp, namespace.sexp) };
 
+    // Lock all module environments now that loading is complete. In debug
+    // builds we skip the lock so modules can be hot-reloaded by the watcher.
+    #[cfg(not(debug_assertions))]
+    RFunction::from("lock_environments").call_in(namespace.sexp)?;
+
     return Ok(namespace);
 }
 
@@ -328,18 +326,18 @@ pub extern "C-unwind" fn ark_log_error(msg: SEXP) -> harp::error::Result<SEXP> {
 #[cfg(test)]
 mod tests {
     use harp::environment::Environment;
-    use libr::CLOENV;
+    use harp::fn_env;
 
     use crate::r_task;
 
     fn get_namespace(exports: Environment, fun: &str) -> Environment {
         let fun = exports.find(fun).unwrap();
-        let ns = unsafe { CLOENV(fun) };
+        let ns = fn_env(fun);
         Environment::view(ns)
     }
 
     #[test]
-    fn test_environments_are_locked() {
+    fn test_environments_are_not_locked_in_debug() {
         r_task(|| {
             let positron_exports =
                 harp::parse_eval_base("as.environment('tools:positron')").unwrap();
@@ -348,14 +346,16 @@ mod tests {
             let positron_exports = Environment::new(positron_exports);
             let rstudio_exports = Environment::new(rstudio_exports);
 
-            assert!(positron_exports.is_locked());
-            assert!(rstudio_exports.is_locked());
+            // Environments are only locked in release builds. In debug
+            // builds they stay unlocked for hot-reloading.
+            assert!(!positron_exports.is_locked());
+            assert!(!rstudio_exports.is_locked());
 
             let positron_ns = get_namespace(positron_exports, ".ps.ark.version");
             let rstudio_ns = get_namespace(rstudio_exports, ".rs.api.versionInfo");
 
-            assert!(positron_ns.is_locked());
-            assert!(rstudio_ns.is_locked());
+            assert!(!positron_ns.is_locked());
+            assert!(!rstudio_ns.is_locked());
         })
     }
 }

crates/ark/src/modules/positron/init.R

@@ -10,15 +10,13 @@ import_positron <- function(exprs) {
 
     # Namespace is created by the sourcer of this file
     ns <- parent.env(environment())
-    local_unlock(ns)
 
     source(exprs = exprs, local = ns)
     export(exprs, from = ns, to = as.environment("tools:positron"))
 }
 
 import_positron_path <- function(path) {
     ns <- parent.env(environment())
-    local_unlock(ns)
 
     source(path, local = ns)
     export_path(path, from = ns, to = as.environment("tools:positron"))
@@ -32,14 +30,9 @@ init_positron <- function() {
 
     # Create environment for functions exported on the search path
     attach(list(), name = "tools:positron")
-
-    # Lock it, we'll unlock when updating
-    lockEnvironment(as.environment("tools:positron"))
 }
 
 export <- function(exprs, from, to) {
-    local_unlock(to)
-
     for (name in exported_names(exprs)) {
         to[[name]] <- from[[name]]
     }
@@ -79,15 +72,13 @@ import_rstudio <- function(exprs) {
     init_rstudio()
 
     env <- rstudio_ns()
-    local_unlock(env)
 
     source(exprs = exprs, local = env)
     export(exprs, from = env, to = as.environment("tools:rstudio"))
 }
 
 import_rstudio_path <- function(path) {
     env <- rstudio_ns()
-    local_unlock(env)
 
     source(path, local = env)
     export_path(path, from = env, to = as.environment("tools:rstudio"))
@@ -109,10 +100,6 @@ init_rstudio <- function() {
     # the modules file again.
     attach(list(.__rstudio_ns__. = rstudio_ns), name = "tools:rstudio")
 
-    # Lock environments, we'll unlock them before updating
-    lockEnvironment(rstudio_ns)
-    lockEnvironment(as.environment("tools:rstudio"))
-
     # Override `rstudioapi::isAvailable()` so it thinks it's running under RStudio
     setHook(
         packageEvent("rstudioapi", "onLoad"),
@@ -139,10 +126,6 @@ rstudio_ns <- function() {
     .Call(.NAME, ..., PACKAGE = "(embedding)")
 }
 
-env_unlock <- function(env) {
-    .ps.Call("ark_env_unlock", env)
-}
-
 defer <- function(expr, envir = parent.frame(), after = FALSE) {
     thunk <- as.call(list(function() expr))
     do.call(
@@ -152,13 +135,6 @@ defer <- function(expr, envir = parent.frame(), after = FALSE) {
     )
 }
 
-local_unlock <- function(env, frame = parent.frame()) {
-    if (environmentIsLocked(env)) {
-        env_unlock(env)
-        defer(lockEnvironment(env), envir = frame)
-    }
-}
-
 # Singleton for cached objects. Only create it if it doesn't exist because
 # `init.R` might be sourced multiple times.
 if (!exists("the", inherits = FALSE)) {
@@ -167,6 +143,13 @@ if (!exists("the", inherits = FALSE)) {
     the$cli_version <- NULL
 }
 
+lock_environments <- function() {
+    ns <- parent.env(environment())
+    lockEnvironment(ns)
+    lockEnvironment(as.environment("tools:positron"))
+    lockEnvironment(rstudio_ns())
+    lockEnvironment(as.environment("tools:rstudio"))
+}
 
 # `initialize_errors()` is called separately in an unsafe context because it
 # doesn't support being called with condition handlers on the stack

crates/ark/src/srcref.rs

@@ -76,7 +76,7 @@ async fn ns_populate_srcref_without_vdoc_insertion(
 
     for b in ns.iter().filter_map(Result::ok) {
         span.in_scope(|| {
-            match generate_source(&b, vdoc.len(), &uri) {
+            match generate_source(&b, ns.inner.sexp, vdoc.len(), &uri) {
                 Ok(Some(mut lines)) => {
                     n_ok = n_ok + 1;
 
@@ -122,6 +122,7 @@ fn ark_ns_uri(ns_name: &str) -> String {
 #[tracing::instrument(level = "trace", skip_all, fields(name = %binding.name))]
 fn generate_source(
     binding: &Binding,
+    ns_env: SEXP,
     line: usize,
     uri: &String,
 ) -> anyhow::Result<Option<Vec<String>>> {
@@ -160,10 +161,8 @@ fn generate_source(
     // Inject source references in functions. This is slightly unsafe but we
     // couldn't think of a dire failure mode.
     unsafe {
-        // First replace the body which contains expressions tagged with srcrefs
-        // such as calls to `{`. Compiled functions are a little more tricky.
+        let body = harp::fn_body(old.sexp);
 
-        let body = BODY(old.sexp);
         if r_typeof(body) == BCODESXP {
             // This is a compiled function. We could recompile the fresh
             // function we just created but the compiler is very slow. Instead,
@@ -179,16 +178,29 @@ fn generate_source(
                 // Inject new body instrumented with source references
                 SET_VECTOR_ELT(consts, 0, R_ClosureExpr(new));
             }
+
+            harp::attrib_poke(
+                old.sexp,
+                r_symbol!("srcref"),
+                harp::attrib_get(new, r_symbol!("srcref")),
+            );
         } else {
-            SET_BODY(old.sexp, BODY(new));
+            let new_body = harp::fn_body(new);
+            let out = RObject::new(harp::new_function(
+                harp::fn_formals(old.sexp),
+                new_body,
+                harp::fn_env(old.sexp),
+            ));
+
+            harp::attrib_poke_from(out.sexp, old.sexp);
+            harp::attrib_poke(
+                out.sexp,
+                r_symbol!("srcref"),
+                harp::attrib_get(new, r_symbol!("srcref")),
+            );
+
+            harp::env_bind_force(ns_env, binding.name.sexp, out.sexp);
         }
-
-        // Finally push the srcref attribute for the whole function
-        Rf_setAttrib(
-            old.sexp,
-            r_symbol!("srcref"),
-            Rf_getAttrib(new, r_symbol!("srcref")),
-        );
     }
 
     let text: Vec<String> = RObject::view(text).try_into()?;

crates/harp/src/attrib.rs

@@ -1,6 +1,12 @@
 use libr::SEXP;
 
 use crate::object::r_length;
+use crate::r::attrib_poke;
+use crate::r::attrib_poke_from;
+use crate::r::fn_body;
+use crate::r::fn_env;
+use crate::r::fn_formals;
+use crate::r::new_function;
 use crate::r_null;
 use crate::r_symbol;
 use crate::RObject;
@@ -18,12 +24,18 @@ pub fn zap_srcref(x: SEXP) -> RObject {
 
 fn zap_srcref_fn(x: SEXP) -> RObject {
     unsafe {
-        let x = RObject::view(x).shallow_duplicate();
+        let formals = fn_formals(x);
+        let body = fn_body(x);
+        let env = fn_env(x);
 
-        x.set_attribute("srcref", r_null());
-        libr::SET_BODY(x.sexp, zap_srcref(libr::R_ClosureExpr(x.sexp)).sexp);
+        let new_body = zap_srcref(body);
+        let out = RObject::new(new_function(formals, new_body.sexp, env));
 
-        x
+        // Copy attributes from the original, but zap `srcref`
+        attrib_poke_from(out.sexp, x);
+        attrib_poke(out.sexp, r_symbol!("srcref"), r_null());
+
+        out
     }
 }
 

crates/harp/src/environment.rs

@@ -15,8 +15,6 @@ use crate::object::RObject;
 use crate::r_env_binding_is_active;
 use crate::symbol::RSymbol;
 
-const FRAME_LOCK_MASK: std::ffi::c_int = 1 << 14;
-
 #[derive(Clone, Debug)]
 pub struct Environment {
     pub inner: RObject,
@@ -76,16 +74,14 @@ impl Environment {
     }
 
     pub fn parent(&self) -> Option<Environment> {
-        unsafe {
-            let parent = ENCLOS(self.inner.sexp);
-            if parent == R_ENVS.empty {
-                None
-            } else {
-                Some(Self::new_filtered(
-                    RObject::new(parent),
-                    self.filter.clone(),
-                ))
-            }
+        let parent = crate::r::env_parent(self.inner.sexp);
+        if parent == R_ENVS.empty {
+            None
+        } else {
+            Some(Self::new_filtered(
+                RObject::new(parent),
+                self.filter.clone(),
+            ))
         }
     }
 
@@ -211,11 +207,6 @@ impl Environment {
         }
     }
 
-    pub fn unlock(&self) {
-        let unlocked_mask = self.flags() & !FRAME_LOCK_MASK;
-        unsafe { libr::SET_ENVFLAGS(self.inner.sexp, unlocked_mask) }
-    }
-
     pub fn lock_binding(&self, name: RSymbol) {
         unsafe {
             libr::R_LockBinding(name.sexp, self.inner.sexp);
@@ -240,10 +231,6 @@ impl Environment {
         r_env_binding_is_active(self.inner.sexp, name.sexp)
     }
 
-    fn flags(&self) -> std::ffi::c_int {
-        unsafe { libr::ENVFLAGS(self.inner.sexp) }
-    }
-
     pub fn as_list(&self) -> harp::Result<RObject> {
         RFunction::new("", "as.list")
             .add(self.inner.sexp)
@@ -270,15 +257,6 @@ impl From<Environment> for RObject {
 unsafe impl Send for REnvs {}
 unsafe impl Sync for REnvs {}
 
-#[harp::register]
-pub extern "C-unwind" fn ark_env_unlock(env: SEXP) -> crate::error::Result<SEXP> {
-    unsafe {
-        crate::check_env(env)?;
-        Environment::view(env).unlock();
-        Ok(libr::R_NilValue)
-    }
-}
-
 pub fn r_ns_env(name: &str) -> anyhow::Result<Environment> {
     let registry = Environment::new(unsafe { R_NamespaceRegistry.into() });
     let ns = registry.find(name)?;