R/runfuncs.R

In rFocal: Run 'FOCAL' Language Source Code

#For now, at least, runFOR will not be used.   

# runFOR <- function(thecmd,   retcode, retidx, strnum) {
# eval(parse(text = thecmd))
# return('doneFor')	
# }


#  no need for a "jumpback" , as even a GOTO inside
# doesn't affect where we return to.   only a GOTO will have a mismatch in nextidx
# added: check for getting a value that indicates a RETURN was executed.
runDO <- function(thecmd, retcode, strnum,  fenv) {
	doidx <- as.numeric(thecmd)
	doMore <- TRUE 
	retcheck <- FALSE # a "return" statement will set to TRUE
	# turn off only when run out of doidx or jumped out  and no more GOTO
# the value of fenv::runidx is set in runRcode.  
	runDOidx <- doidx[1]
#  signal not used at present
  rcode <- "DID"
	while(doMore) {
		nextidx <- runDOidx + 1   #preset non-GOTO value
		 eval(parse(text = retcode[[runDOidx ]]))	
 # retcheck gets set to TRUE if the retcode was a RETURN
		if (retcheck){
			doMore=FALSE
			break
		}
		if(nextidx != runDOidx + 1){
# a GOTO to somewhere
			if(nextidx %in% doidx) {
# GOTO inside DO block (or current set of retcode belonging to the GOTO sent us)
				runDOidx <- nextidx
				next
			} else{
#GOTO somewhere new outside DO  block (or the current line we GOTO-ed)
				dnum <- strnum[nextidx,] #the 'oddball' nextidx from GOTO cmd
	# luckily :-), the indices of rows in strnum match values in retidx
				goidx <- intersect(which(strnum[,1]== dnum[1]), which(strnum[,2] ==dnum[2]))
# now execute all these didx,  which is easiest to do by doing:
			    doidx <- goidx; 
			    runDOidx <- doidx[1]	
			}			
		} else{
			 runDOidx <- nextidx  # 'normal' sequence
			if(!(runDOidx %in% doidx)) doMore <- FALSE
	}# end of outer ifelse
	
} # end of while
# note: returned list not currently used anywhere
return(list(rcode = rcode) )
}

#capture user-input and put results into fenv
# makeASK() will have ensured the var exists in fenv
runASK <- function(thecmd, fenv) {
theprompt <- paste0('enter ',thecmd,' : ',collapse = '')
tmpval <- tolower(readline(theprompt)  )
# catch empty input -- set equal to zero at least for now
if(tmpval == '') tmpval <- '0'
# convert tmpval to numeric as necessary
tmpval <-trimws(tmpval)
# idiot might respond with (56;) or some such shit.
# # FOCAL uses an up-arrow. I  disallow
tmpval <- gsub('[^-0-9a-z^.]','',tmpval)
#  if it's a legal alpha like "4d"  3rd condition fixes that
if( !grepl('[0-9]',tmpval) || grepl('^[0-9]{1,}[a-z]{1,}[^0-9]', tmpval) ||grepl('^[0-9]{1,}[a-z]{1,}$',tmpval) ){
#stick on a lead numeric to handle first case	
# send something that looks like a string of crud to avoid 
# edge cases w/ no lead or trailing chars to cover.
	tmpval <- paste0(c('this 0',tmpval,' junk'),collapse='')
# use same regex as in prepareCode()
	theregex <- gregexpr('[^a-z][0-9]{1,}[a-z]{1,}[^0-9-]',tmpval,perl=TRUE)
# have to remove lead and follow crap
	tmpval <- numchar2num(tmpval,theregex)
	tmpval <- sub('this','',tmpval)
	tmpval <- paste0(sub('junk','',tmpval),collapse='')
	tmpval <- as.numeric(tmpval)
	# }
} else {
# It's not a 'character number'
	if(grepl('\\^',tmpval)) {
			numtmp <- unlist(strsplit(tmpval,'\\^'))
			tmpval <- as.numeric(numtmp[1])^as.numeric(numtmp[2])
			
	} else{ 
		tmpval <- as.numeric(tmpval)
	 }
} #end of top-level ifelse
eval(parse(text = paste0(thecmd, '<<- tmpval',collapse = '')))
# return this for consistency of return structure
return(list(rcode = "asked", nextidx = -20) )	
}

# makeSET ensures the variable exists in fenv
#  don't need runSET at all,
# because makeSet also replaces "=" in FOCAL with "<<-" now;
# this function is never called.  
# runSET <- function(thecmd, retcode, retidx, strnum) {
		# eval(parse(text = gsub('<-','<<-',thecmd)))
# return(thecmd)
# }