code2LazyLoadDB <-
    function(package, lib.loc = NULL,
             keep.source = getOption("keep.source.pkgs"),
             compress = TRUE)
{
    pkgpath <- .find.package(package, lib.loc, quiet = TRUE)
    if(length(pkgpath) == 0)
        stop(gettextf("there is no package called '%s'", package),
             domain = NA)
    barepackage <- sub("([^-]+)_.*", "\\1", package)
    loadenv <- new.env(hash=TRUE)
    codeFile <- file.path(pkgpath, "R", barepackage)
    dbbase <- file.path(pkgpath, "R", barepackage)
    if (packageHasNamespace(package, dirname(pkgpath))) {
        if (! is.null(.Internal(getRegisteredNamespace(as.name(package)))))
            stop("name space must not be loaded.")
        ns <- loadNamespace(package, lib.loc, keep.source, TRUE, TRUE)
        makeLazyLoadDB(ns, dbbase)
    }
    else {
        loadenv <- new.env(hash = TRUE, parent = .GlobalEnv)
        if(file.exists(codeFile))
            sys.source(codeFile, loadenv, keep.source = keep.source)
        ## now transfer contents of loadenv to a new env to mimic library
        ## the actual copy has to be done by C code to avoid forcing
        ## promises that might have been created using delay().
        env <- new.env(hash=TRUE)
        .Internal(lib.fixup(loadenv, env))
        ## save the package name in the environment
        assign(".packageName", barepackage, envir = env)
        makeLazyLoadDB(env, dbbase, compress = compress)
    }
}

rda2LazyLoadDB <- function(package, lib.loc = NULL, compress = TRUE)
{
    pkgpath <- .find.package(package, lib.loc, quiet = TRUE)
    if(length(pkgpath) == 0)
        stop(gettextf("there is no package called '%s'", package),
             domain = NA)
    rdafile <- file.path(pkgpath, "R", "all.rda")
    if (! file.exists(rdafile))
        stop(gettextf("package '%s' has no .rda file", package),
             domain = NA)
    dbbase <- file.path(pkgpath, "R", package)
    e <- new.env(hash=TRUE)
    load(rdafile, e)
    makeLazyLoadDB(e, dbbase, compress = compress)
}

sysdata2LazyLoadDB <- function(srcFile, destDir, compress = TRUE)
{
    e <- new.env(hash=TRUE)
    load(srcFile, e)
    makeLazyLoadDB(e, file.path(destDir, "sysdata"), compress = compress)
}

list_data_in_pkg <- function(package, lib.loc = NULL, dataDir = NULL)
{
    if(is.null(dataDir)) {
        pkgpath <- .find.package(package, lib.loc, quiet = TRUE)
        if(length(pkgpath) == 0)
            stop(gettextf("there is no package called '%s'", package),
                 domain = NA)
        dataDir <- file.path(pkgpath, "data")
    } else {
        pkgpath <- sub("/data$", "", dataDir)
        package <- basename(pkgpath)
	# avoid builddir != srcdir problems -- assume package has been installed
        lib.loc <- c(dirname(pkgpath), .libPaths())
    }
    if(file_test("-d", dataDir)) {
        if(file.exists(sv <- file.path(dataDir, "Rdata.rds"))) {
            ans <- .readRDS(sv)
        } else if(file.exists(sv <- file.path(dataDir, "datalist"))) {
            ans <- strsplit(readLines(sv), ":")
            nms <- lapply(ans, function(x) x[1])
            ans <- lapply(ans, function(x)
                          if(length(x)==1) x[1] else
                          strsplit(x[2], " +")[[1]][-1])
            names(ans) <- nms
        } else {
            files <- list_files_with_type(dataDir, "data")
            files <- unique(basename(file_path_sans_ext(files)))
            ans <- vector("list", length(files))
            dataEnv <- new.env(hash=TRUE)
            names(ans) <- files
            for(f in files) {
                utils::data(list = f, package = package, lib.loc = lib.loc,
                            envir = dataEnv)
                ans[[f]] <- ls(envir = dataEnv, all.names = TRUE)
                rm(list = ans[[f]], envir = dataEnv)
            }
        }
        ans
    } else NULL
}

data2LazyLoadDB <- function(package, lib.loc = NULL, compress = TRUE)
{
    options(warn=1)
    pkgpath <- .find.package(package, lib.loc, quiet = TRUE)
    if(length(pkgpath) == 0)
        stop(gettextf("there is no package called '%s'", package),
             domain = NA)
    dataDir <- file.path(pkgpath, "data")
    ## set the encoding for text files to be read, if specified
    enc <- .read_description(file.path(pkgpath, "DESCRIPTION"))["Encoding"]
    if(!is.na(enc)) options(encoding=enc)
    if(file_test("-d", dataDir)) {
        if(file.exists(file.path(dataDir, "Rdata.rds")) &&
	    file.exists(file.path(dataDir, paste(package, "rdx", sep="."))) &&
	    file.exists(file.path(dataDir, paste(package, "rdb", sep="."))) ){
            warning("package seems to be using lazy loading for data already")
        }
	else {
            dataEnv <- new.env(hash=TRUE)
            tmpEnv <- new.env()
            f0 <- files <- list_files_with_type(dataDir, "data")
            files <- unique(basename(file_path_sans_ext(files)))
            dlist <- vector("list", length(files))
            names(dlist) <- files
            loaded <- character(0)
            for(f in files) {
                utils::data(list = f, package = package, lib.loc = lib.loc,
                        envir = dataEnv)
                utils::data(list = f, package = package, lib.loc = lib.loc,
                        envir = tmpEnv)
                tmp <- ls(envir = tmpEnv, all.names = TRUE)
                rm(list = tmp, envir = tmpEnv)
                dlist[[f]] <- tmp
                loaded <- c(loaded, tmp)
            }
            dup<- duplicated(loaded)
            if(any(dup))
                warning(gettextf("object(s) %s are created by more than one data call",
                                 paste(sQuote(loaded[dup]),
                                       collapse=", ")),
                        domain = NA)

            if(length(loaded)) {
                dbbase <- file.path(dataDir, "Rdata")
                makeLazyLoadDB(dataEnv, dbbase, compress = compress)
                .saveRDS(dlist, file.path(dataDir, "Rdata.rds"),
                         compress = compress)
                print(f0)
                unlink(f0)
                if(file.exists(file.path(dataDir, "filelist")))
                    unlink(file.path(dataDir, c("filelist", "Rdata.zip")))
            }
        }
    }
}

makeLazyLoadDB <- function(from, filebase, compress = TRUE, ascii = FALSE,
                           variables)
{
    envlist <- function(e) {
        names <- ls(e, all.names=TRUE)
        .Call("R_getVarsFromFrame", names, e, FALSE, PACKAGE="base")
    }

    envtable <- function() {
        idx <- 0
        envs <- NULL
        enames <- character(0)
        find <- function(v, keys, vals)
            for (i in seq_along(keys))
                if (identical(v, keys[[i]]))
                    return(vals[i])
        getname <- function(e) find(e, envs, enames)
        getenv <- function(n) find(n, enames, envs)
        insert <- function(e) {
            idx <<- idx + 1
            name <- paste("env", idx, sep="::")
            envs <<- c(e, envs)
            enames <<- c(name, enames)
            name
        }
        list(insert = insert, getenv = getenv, getname = getname)
    }

    lazyLoadDBinsertValue <- function(value, file, ascii, compress, hook)
        .Call("R_lazyLoadDBinsertValue", value, file, ascii, compress, hook,
              PACKAGE = "base")

    lazyLoadDBinsertListElement <- function(x, i, file, ascii, compress, hook)
        .Call("R_lazyLoadDBinsertValue", x[[i]], file, ascii, compress, hook,
              PACKAGE = "base")

    lazyLoadDBinsertVariable <- function(n, e, file, ascii, compress, hook) {
        x <- .Call("R_getVarsFromFrame", n, e, FALSE, PACKAGE="base")
       .Call("R_lazyLoadDBinsertValue", x[[1]], file, ascii, compress, hook,
              PACKAGE = "base")
    }

    mapfile <- paste(filebase, "rdx", sep = ".")
    datafile <- paste(filebase, "rdb", sep = ".")
    close(file(datafile, "wb")) # truncate to zero
    table <- envtable()
    varenv <- new.env(hash = TRUE)
    envenv <- new.env(hash = TRUE)

    envhook <- function(e) {
        if (is.environment(e)) {
            name <- table$getname(e)
            if (is.null(name)) {
                name <- table$insert(e)
                data <- list(bindings = envlist(e),
                             enclos = parent.env(e))
                key <- lazyLoadDBinsertValue(data, datafile, ascii,
                                             compress, envhook)
                assign(name, key, envir = envenv)
            }
            name
        }
    }

    if (is.null(from) || is.environment(from)) {
        if (! missing(variables))
            vars <- variables
        else vars <- ls(from, all.names = TRUE)
    }
    else if (is.list(from)) {
        vars <- names(from)
        if (length(vars) != length(from) || any(!nzchar(vars)))
            stop("source list must have names for all elements")
    }
    else stop("source must be an environment or a list")

    for (i in seq_along(vars)) {
        key <- if (is.null(from) || is.environment(from))
            lazyLoadDBinsertVariable(vars[i], from, datafile,
                                     ascii, compress,  envhook)
        else lazyLoadDBinsertListElement(from, i, datafile, ascii,
                                         compress, envhook)
        assign(vars[i], key, envir = varenv)
    }

    vals <- lapply(vars, get, envir = varenv, inherits = FALSE)
    names(vals) <- vars

    rvars <- ls(envenv, all.names = TRUE)
    rvals <- lapply(rvars, get, envir = envenv, inherits = FALSE)
    names(rvals) <- rvars

    val <- list(variables = vals, references = rvals,
                compressed = compress)
   .saveRDS(val, mapfile)
}

makeLazyLoading <-
    function(package, lib.loc = NULL, compress = TRUE,
             keep.source = getOption("keep.source.pkgs"))
{
    options(warn=1)
    findpack <- function(package, lib.loc) {
        pkgpath <- .find.package(package, lib.loc, quiet = TRUE)
        if(length(pkgpath) == 0)
            stop(gettextf("there is no package called '%s'", package),
                 domain = NA)
        pkgpath
    }

    pkgpath <- findpack(package, lib.loc)
    barepackage <- sub("([^-]+)_.*", "\\1", package)

    if (package == "base")
        stop("this cannot be used for package 'base'")
    else if (packageHasNamespace(package, dirname(pkgpath)))
        loaderFile <- file.path(R.home("share"), "R", "nspackloader.R")
    else
        loaderFile <- file.path(R.home("share"), "R", "packloader.R")
    codeFile <- file.path(pkgpath, "R", barepackage)

    if (!file.exists(codeFile)) {
        warning("package contains no R code")
        return(invisible())
    }
    if (file.info(codeFile)["size"] == file.info(loaderFile)["size"])
        warning("package seems to be using lazy loading already")
    else {
        rdaFile <- file.path(pkgpath, "R", "all.rda")
        if (file.exists(rdaFile))
            rda2LazyLoadDB(package, lib.loc, compress = compress)
        else
            code2LazyLoadDB(package, lib.loc = lib.loc,
                            keep.source = keep.source, compress = compress)
        file.copy(loaderFile, codeFile, TRUE)
    }

    invisible()
}