[Rd] stopifnot

[Martin Maechler]

>>>>> Martin Maechler 
>>>>>     on Mon, 3 Jun 2019 18:14:15 +0200 writes:

>>>>> Suharto Anggono Suharto Anggono 
>>>>>     on Thu, 30 May 2019 14:45:22 +0000 writes:
>>>>> Suharto Anggono Suharto Anggono 
>>>>>     on Thu, 30 May 2019 14:45:22 +0000 writes:

    >> Here is a patch to function 'stopifnot' that adds 'evaluated' argument and makes 'exprs' argument in 'stopifnot' like 'exprs' argument in 'withAutoprint'.

    >> --- stop.R	2019-05-30 14:01:15.282197286 +0000
    >> +++ stop_new.R	2019-05-30 14:01:51.372187466 +0000

    > [..........]

    > Thank you, Suharto.

    > I've looked at the patch and tested it a bit, and also (re)read
    > your April 15 remarks (cited below).  I now agree that my hacks to
    > enable dealing with "language objects" (typically class
    > 'expression')  'exprs' has remained hackish and hence not
    > working in all cases,  and that it may be a better idea to add
    > a new logical argument (as in other functions) which has to be
    > "switched" and then leads somewhat simpler and more robust code.

    > OTOH, of course, this is an API change would typically not go into the R
    > 3.6.x series ... and I have no idea if it would affect much more
    > than R's own tests/reg-tests-* ...

    > Even though the argument name 'evaluated' was chosen for
    > withAutoprint(), I don't find it a very good name anymore, and -
    > if the change should happen - would probably prefer something
    > like 'is.language' or 'expr.is.language' or similar..

    > Could we get any other readers' opinions ?

[none ..]

In the mean time, I've seen a nicer solution:  If have to add
yet another argument to stopifnot() to make this cleaner, I'm
now pretty sure we should rather use that new argument  to pass
an "expression-alike" object instead of unevaluated expressions.

I'm calling it `exprObject`  for now (and ditch the `evaluated=FALSE`).
With that the new code becomes even cleaner and easier to understand:

stopifnot <- function(..., exprs, exprObject, local = TRUE)
{
    n <- ...length()
    if((has.e <- !missing(exprs)) || !missing(exprObject)) {
	if(n || (has.e && !missing(exprObject)))
	    stop("Only one of 'exprs', 'exprObject' or unnamed expressions, not more")
	envir <- if (isTRUE(local)) parent.frame()
		 else if(isFALSE(local)) .GlobalEnv
		 else if (is.environment(local)) local
		 else stop("'local' must be TRUE, FALSE or an environment")
	E1 <- if(has.e && is.call(exprs <- substitute(exprs))) exprs[[1]]
	cl <- if(is.symbol(E1) &&
		 E1 == quote(`{`)) {
		  exprs[[1]] <- quote(stopifnot) ## --> stopifnot(*, *, ..., *) :
		  exprs
	      }
	      else
		  as.call(c(quote(stopifnot),
			    if(!has.e) exprObject else as.expression(exprs)))
        names(cl) <- NULL
	return(eval(cl, envir=envir))
    }
    ## else   use '...' (and not 'exprs') :

   [............ code unchanged from here to the end .. ............]
   [............ code unchanged from here to the end .. ............]
}