@@ -20,21 +20,18 @@ RCcompilerLevel1 <- function(optMeta1) {

     # matrix index offset

     gpu_gp_offset = GPUVar$global_private_offset

+    gpu_gs_offset = GPUVar$global_shared_offset

+    gpu_ls_offset = GPUVar$local_shared_offset

     # worker shared data, located in global memory

     gpu_gs_data = GPUVar$global_shared_data

-    gpu_gs_offset = GPUVar$global_shared_offset

-    

     # worker private data, located in private/local memory

     gpu_lp_data = GPUVar$local_private_data

-    gpu_lp_offset = GPUVar$local_private_offset

-    

     # worker shared data, located in local memory

     gpu_ls_data = GPUVar$local_shared_data

-    gpu_ls_offset = GPUVar$local_shared_offset

-    gpu_sizeInfo = GPUVar$size_info

+    gpu_sizeInfo = GPUVar$size_info

     gpu_returnSize = GPUVar$return_size

     # Deducted variable

@@ -51,8 +48,6 @@ RCcompilerLevel1 <- function(optMeta1) {

     var_def_code = c()

-    redirect_code=c()

-    redirect_var=c()

     gpu_gp_num = -1

     gpu_gs_num = -1

     gpu_lp_num = -1

@@ -80,13 +75,6 @@ RCcompilerLevel1 <- function(optMeta1) {

           if(isNA(curInfo$address)){

             curInfo$address = curVar

           }

-          if(curInfo$redirect!="NA"){

-            curCode=paste0("#define ", curVar, " ", curInfo$redirect)

-            curSize1=paste0("#define ", getSizeVar(curVar,1)," ",getSizeVar(curInfo$redirect,1))

-            curSize2=paste0("#define ", getSizeVar(curVar,2)," ",getSizeVar(curInfo$redirect,2))

-            redirect_code=c(redirect_code,curCode,curSize1,curSize2)

-            redirect_var=c(redirect_var,curVar)

-          }

           # If the variable is the function argument

           if (curInfo$require) {

             gpu_gs_num = gpu_gs_num + 1

@@ -101,11 +89,9 @@ RCcompilerLevel1 <- function(optMeta1) {

         if (!curInfo$isPointer) {

-            CXXtype = getTypeCXXStr(curInfo$precisionType)

-            curCode = paste0(CXXtype, " ", curVar, ";")

-            var_def_code = rbind(var_def_code,c(curVar, curCode))

-            curInfo$address = curVar

-            varInfo = setVarInfo(varInfo, curInfo)

+            res=addVariableDeclaration_NonPointer(varInfo,curInfo)

+            var_def_code = rbind(var_def_code,c(curVar, res$code))

+            varInfo = setVarInfo(varInfo, res$Info)

             next

         }

@@ -150,11 +136,37 @@ RCcompilerLevel1 <- function(optMeta1) {

     }

+    gpu_gp_num=gpu_gp_num+1

+    gpu_gs_num=gpu_gs_num+1

+    gpu_lp_num=gpu_lp_num+1

+    gpu_ls_num=gpu_ls_num+1

+    # size_info:

+    # return size, gp,gs,ls offset, gp,gs,lp,ls dim(row,col) 

+    data_offset=1

+    data_offset_var=c(gpu_gp_offset,gpu_gs_offset,gpu_ls_offset)

+    data_offset_var_offset=c(gpu_gp_num,gpu_gs_num,gpu_ls_num)

+    data_offset_macro=offsetMacro(gpu_sizeInfo,data_offset,data_offset_var,data_offset_var_offset)

+    

+    #Define matrix size macro

+    dim_offset=data_offset+gpu_gp_num+gpu_gs_num+gpu_ls_num

+    size_var=c(paste0(GPUVar$gp_size,1:2),

+               paste0(GPUVar$gs_size,1:2),

+               paste0(GPUVar$lp_size,1:2),

+               paste0(GPUVar$ls_size,1:2))

+    size_offset=c(gpu_gp_num,gpu_gp_num,

+                  gpu_gs_num,gpu_gs_num,

+                  gpu_lp_num,gpu_lp_num,

+                  gpu_ls_num,gpu_ls_num)

+    size_macro=offsetMacro(gpu_sizeInfo,dim_offset,size_var,size_offset)

+    

     gpu_code = c(

       "//Define some useful macro", 

       paste0("#define ", gpu_worker_offset, " ", gpu_global_id),

       paste0("#define ", gpu_element_dist, " ", gpu_global_id),

+      paste0("#define ", gpu_returnSize, " ", gpu_sizeInfo,"[0]"),

+      data_offset_macro,

+      size_macro,

       "//Data preparation", 

       paste0("size_t ", gpu_global_id, "=get_global_id(0);"),

@@ -165,19 +177,30 @@ RCcompilerLevel1 <- function(optMeta1) {

       "//Matrix dimension optimization")

-    

+    var_def_code=as.data.frame(var_def_code,stringsAsFactors=FALSE)

+    colnames(var_def_code)=c("var","def")

     varInfo$var_def_code=var_def_code

-    varInfo$redirect_var=redirect_var

     GPUExp1$Exp = parsedExp

     GPUExp1$varInfo = varInfo

     GPUExp1$gpu_code = gpu_code

-    GPUExp1$macro=c(GPUExp1$macro,redirect_code)

     return(GPUExp1)

 }

+offsetMacro<-function(targetVar,offset,macroName,macroLength){

+  redundant_ind=which(macroLength==0)

+  macroName=macroName[-redundant_ind]

+  macroLength=macroLength[-redundant_ind]

+  macro_offset=c(0)

+  for(i in seq_len(length(macroLength)-1)+1){

+    macro_offset=c(macro_offset,macro_offset[i-1]+macroLength[i-1])

+  }

+  macro_offset=macro_offset+offset

+  macro=paste0("#define ",macroName,"(x) ",targetVar,"[",macro_offset,"+x]")

+  macro

+}

 RCcompilerLevel2 <- function(GPUExp1) {

     if (DEBUG) {

@@ -202,7 +225,8 @@ RCcompilerLevel2 <- function(GPUExp1) {

 RCTranslation <- function(varInfo, parsedExp,isTop=FALSE) {

     gpu_code = c()

-    delim=switch(isTop,"\\Main function delimiter",NULL)

+    delim=switch(isTop,"//Main function delimiter",NULL)

+    #delim=NULL

     for (i in seq_along(parsedExp)) {

         curExp = parsedExp[[i]]

         if (curExp == "{" || is.symbol(curExp)) 

@@ -43,14 +43,14 @@ C_assignment_dispatch <- function(varInfo, Exp) {

 # ==================element functions===========================

-

+#Exp=quote({a1 = A[ind2, ]})[[2]]

 C_element_OP <- function(varInfo, Exp) {

     leftExp = Exp[[2]]

     rightExp = Exp[[3]]

     leftInfo = getVarInfo(varInfo, leftExp)

     if (leftInfo$dataType == T_scale) {

-        sub = c("1", "1")

+        sub = c("0", "0")

         leftElement = C_element_getCExp(varInfo, leftExp, sub = sub, opt = NULL)

         rightElement = C_element_getCExp(varInfo, rightExp, sub = sub, extCode = leftElement$extCode, opt = NULL)

     } else {

@@ -71,11 +71,22 @@ C_element_OP <- function(varInfo, Exp) {

           code = c("{", extCode, assignmentCode, "}")

         }

     } else {

+      if(is.null(extCode$L0)){

       code = C_matrix_assignment(

         assignmentCode, 

         loopInd1 = "gpu_element_j", loopEnd1 = R_ncol(varInfo, leftExp), 

         loopInd2 = "gpu_element_i",  loopEnd2 = R_nrow(varInfo, leftExp), 

-        loopCode0 = extCode$L0, loopCode1 = extCode$L1, loopCode2 = extCode$L2)

+        loopCode0 = NULL, loopCode1 = extCode$L1, loopCode2 = extCode$L2)

+      }else{

+        code = c(

+          "{",

+          C_matrix_assignment(

+            assignmentCode, 

+            loopInd1 = "gpu_element_j", loopEnd1 = R_ncol(varInfo, leftExp), 

+            loopInd2 = "gpu_element_i",  loopEnd2 = R_nrow(varInfo, leftExp), 

+            loopCode0 = extCode$L0, loopCode1 = extCode$L1, loopCode2 = extCode$L2),

+          "}")

+      }

     }

     return(code)

 }

@@ -172,7 +183,7 @@ C_element_abs<-function(varInfo, Exp, sub, opt, extCode){

   return(res)

 }

 processSub<-function(varInfo, Exp, sub, opt, extCode){

-  if(deparse(Exp)==""){

+  if(Exp==""){

     res = list(value = sub, extCode = extCode)

     return(res)

   }

@@ -182,16 +193,32 @@ processSub<-function(varInfo, Exp, sub, opt, extCode){

 }

 C_element_sub<-function(varInfo, Exp, sub, opt, extCode){

+  args=matchBracketFunc(Exp)

   targetExp=Exp[[2]]

-  sub1=processSub(varInfo, Exp[[3]],sub[1],extCode = extCode, opt = opt)

- 

+  sub1=processSub(varInfo, args$i,sub[1],extCode = extCode, opt = opt)

-  if (length(sub) == 1) {

-    res = C_element_getCExp(varInfo, targetExp,sub=sub1$value, extCode = sub1$extCode, opt = opt)

-  } else {

-    sub2=processSub(varInfo, Exp[[4]],sub[2],extCode = sub1$extCode, opt = opt)

-    res = C_element_getCExp(varInfo, targetExp,sub=c(sub1$value,sub2$value), extCode = sub2$extCode, opt = opt)

+  if(length(sub) == 1){

+    #two index bracket -- one index sub

+    if(!is.null(args$j)){

+      rowNum = R_nrow(varInfo,Exp)

+      res_twoIndex=one_to_two_index(sub1$value,extCode = sub1$extCode,rowNum=rowNum)

+      sub_new=c(res$i,res$j)

+      res = C_element_getCExp(varInfo, Exp, sub=sub_new, extCode = res$extCode, opt = opt)

+    }else{

+      #one index bracket -- one index sub

+      res = C_element_getCExp(varInfo, targetExp,sub=sub1$value, extCode = sub1$extCode, opt = opt)

+    }

+  }else{

+    if(!is.null(args$j)){

+      sub2=processSub(varInfo, args$j,sub[2],extCode = sub1$extCode, opt = opt)

+      #two index bracket -- two index sub

+      res = C_element_getCExp(varInfo, targetExp,sub=c(sub1$value,sub2$value), extCode = sub2$extCode, opt = opt)

+    }else{

+      #one index bracket -- two index sub

+      res = C_element_getCExp(varInfo, targetExp,sub=sub1$value, extCode = sub1$extCode, opt = opt)

+    }

   }

+  

   return(res)

 }

@@ -535,6 +562,20 @@ C_rowSums_right<-function(varInfo, Exp){

   code

 }

+#Exp=quote(compiler.define(A,B))

+C_compiler_define<-function(varInfo, Exp){

+  vars=extractVars(Exp)

+  code=c()

+  for(var in vars){

+    curInfo=getVarInfo(varInfo,var)

+    ind=which(varInfo$var_def_code$var==var)

+    if(length(ind)==0)

+      stop("Unable to find the variable ",var," in the variable define table.\n Current expression: ",deparse(Exp))

+    varDef=varInfo$var_def_code$def[ind]

+    code=c(code,varDef)

+  }

+  code

+}

 ########################################## Super lengthy function##############################

@@ -1,8 +1,9 @@

-# C_element_getCExp(varInfo,quote(A[ind,]),c(3,6)-1,opt=NULL)

+# C_element_getCExp(varInfo,quote((At+A)[ind,]),c(3,6)-1,opt=NULL)

 R_expression_sub <- function(varInfo, Exp, sub, opt = NULL, extCode = NULL) {

     # fill the vector with the first element to make the length of it

     # consistant with the length of Exp

+    

     curInfo = getVarInfo(varInfo, Exp)

     if (curInfo$isRef) {

       refExp = parse(text = curInfo$specialContent)[[1]]

@@ -47,33 +48,38 @@ R_expression_sub <- function(varInfo, Exp, sub, opt = NULL, extCode = NULL) {

 # Expression should be a variable or a matrix subset

 # R_oneIndex_exp_sub(varInfo,quote(A[tmp1]),3)

 R_oneIndex_exp_sub <- function(varInfo, Exp, k, opt = NULL, extCode = NULL) {

-    index_type=GPUVar$default_index_type

+    

     # If the expression is a variable

     curInfo = getVarInfo(varInfo, Exp)

     rowNum = R_nrow(varInfo,Exp)

-    

-    col_ind_var = GPUVar$getTmpVar()

-    col_ind_value = CSimplify(paste0("(", index_type, ")((", 

-                                    k, ")/(", rowNum, "))"))

-    # if the temporary variable is a constant, it will be plug into the

-    # code Otherwise, create a temporary variable for it

-    if (isNumeric(col_ind_value) || length(grep("/", col_ind_value, fixed = TRUE)) == 

-        0) {

-      col_ind_var = paste0("(", col_ind_value, ")")

-    } else {

-      res = getVarFromExtCode(extCode, index_type, col_ind_value)

-      col_ind_var = res$var

-      extCode = res$extCode

-    }

-    

-    i = paste0(k, "-", rowNum, "*", col_ind_var)

-    j = col_ind_var

-    

-    res = R_getVarSub(varInfo, Exp, i = i, j = j, opt = opt, extCode = extCode)

-    

+    res_index=one_to_two_index(k,extCode = extCode,rowNum=rowNum)

+    res = R_getVarSub(varInfo, Exp, i = res_index$i, j = res_index$j, opt = opt, extCode = res_index$extCode)

     return(res)

 }

+#Return: i, j, extCode

+one_to_two_index<-function(k,extCode,rowNum){

+  

+  index_type=GPUVar$default_index_type

+  col_ind_var = GPUVar$getTmpVar()

+  col_ind_value = CSimplify(paste0("(", index_type, ")((", 

+                                   k, ")/(", rowNum, "))"))

+  # if the temporary variable is a constant, it will be plug into the

+  # code Otherwise, create a temporary variable for it

+  if (isNumeric(col_ind_value) || length(grep("/", col_ind_value, fixed = TRUE)) == 

+      0) {

+    col_ind_var = col_ind_value

+  } else {

+    res = getVarFromExtCode(extCode, index_type, col_ind_value)

+    col_ind_var = res$var

+    extCode = res$extCode

+  }

+  

+  i = CSimplify(paste0(k, "-", rowNum, "*(", col_ind_var,")"))

+  j = CSimplify(col_ind_var)

+  

+  return(list(i=i,j=j,extCode=extCode))

+}

 # Get an element from the matrix(eg. A[i,j]), the transpose will be

 # taken into account 

 # i,j are either a number or a variable in C code , they are 0-based index

@@ -95,19 +101,24 @@ R_getVarSub <- function(varInfo, var, i, j = 1, opt = NULL, extCode = NULL) {

     #If the data is not a pointer, it is a scalar, then directly return the address

     if(is.na(isPointer)) stop("Unable to determine the type of the variable,",

                               " this is a bug in the package, please contact the author.")

-    if(!isPointer) 

-      return(list(value =address,extCode=extCode))

-    #If the data is a pointer, but the size is 1, then return the first element in the address

-    if((curInfo$size1=="1"&&curInfo$size2=="1")||curInfo$dataType==T_scale){

-      if(!curInfo$isSeq){

-        return(list(value =paste0(address,"[0]"),extCode=extCode))

-      }else{

-        seqInfo = getSeqAddress(varInfo, var)

-        return(list(value =seqInfo$from,extCode=extCode))

+    

+    

+    

+    if(!isPointer) {

+      if(!curInfo$isSeq)

+        return(list(value =address,extCode=extCode))

+    }else{

+      #If the data is a pointer, but the size is 1, then return the first element in the address

+      if((curInfo$size1=="1"&&curInfo$size2=="1")||curInfo$dataType==T_scale){

+        if(!curInfo$isSeq){

+          return(list(value =paste0(address,"[0]"),extCode=extCode))

+        }else{

+          seqInfo = getSeqAddress(varInfo, var)

+          return(list(value =seqInfo$from,extCode=extCode))

+        }

       }

     }

-    

     # compute the matrix offset

     size1 = R_getVarSize(varInfo, var,C_symbol = FALSE,ind=1,processTranspose = FALSE)

@@ -122,7 +133,6 @@ R_getVarSub <- function(varInfo, var, i, j = 1, opt = NULL, extCode = NULL) {

     if (curInfo$isSeq) {

       seqInfo = getSeqAddress(varInfo, var)

-      

       res = list(extCode=extCode)

       res$value = CSimplify(paste0(seqInfo$from, "+", "(", rowOffset, 

                                    "-1)*", seqInfo$by))

@@ -185,7 +195,7 @@ R_getVarSize <- function(varInfo, var,C_symbol, ind,processTranspose=TRUE) {

         return(res)

       }

       if (curInfo$isSeq) {

-        res=ifelse(ind==1,getSizeVar(var_char,ind),1)

+        res=ifelse(ind==1,getSizeVar(var_char,1),1)

         return(res)

       }

       if (curInfo$dataType == T_scale) 

@@ -51,6 +51,11 @@ addVariableDeclaration <- function(varInfo,curInfo, data, offset, offsetInd,pref

   location = paste0(prefix, " ")

   curInfo$address = curInfo$var

+  if(curInfo$redirect!="NA"){

+    redirectInfo=getVarInfo(varInfo,curInfo$redirect)

+    curCode = paste0("#define ",curInfo$var," ",redirectInfo$address)

+    return(list(code=curCode,Info=curInfo))

+  }

   # If the variable is a sequence

   if (curInfo$isSeq) {

@@ -59,7 +64,7 @@ addVariableDeclaration <- function(varInfo,curInfo, data, offset, offsetInd,pref

     } else {

       curCode = paste0(location, CXXtype, 3, "* ", curInfo$var, 

                        "=", "((", location, CXXtype, 3, "*)(", data, "+", offset, 

-                       "[", offsetInd, "]))+",worker_offset,";")

+                       "(", offsetInd, ")))+",worker_offset,";")

     }

     return(list(code=curCode,Info=curInfo))

   }

@@ -73,12 +78,31 @@ addVariableDeclaration <- function(varInfo,curInfo, data, offset, offsetInd,pref

     }

   }else{

       curCode = paste0(location, CXXtype, "* ", curInfo$var, "=", 

-                       "((", location, CXXtype, "*)(", data, "+", offset, "[", offsetInd, 

-                       "]))+",worker_offset,";")

+                       "((", location, CXXtype, "*)(", data, "+", offset, "(", offsetInd, 

+                       ")))+",worker_offset,";")

+  }

+  return(list(code=curCode,Info=curInfo))

+}

+

+addVariableDeclaration_NonPointer<-function(varInfo,curInfo){

+  curVar=curInfo$var

+  CXXtype = getTypeCXXStr(curInfo$precisionType)

+  curInfo$address=curVar

+  if(curInfo$redirect!="NA"){

+    redirectInfo=getVarInfo(varInfo,curInfo$redirect)

+    curCode = paste0("#define ",curVar," ",redirectInfo$address)

+    return(list(code=curCode,Info=curInfo))

+  }

+  

+  if (curInfo$isSeq){

+    curCode = paste0(CXXtype, 3, " ", curInfo$var, ";")

+  }else{

+    curCode = paste0(CXXtype, " ", curVar, ";")

   }

   return(list(code=curCode,Info=curInfo))

 }

+

 getSizeVar<-function(varName,i){

   paste0(GPUVar$matrix_size_prefix, varName,"_dim_",i)

 }

@@ -208,7 +232,7 @@ getSeqAddress <- function(varInfo, var,C_symbol=FALSE) {

     from = paste0(ad, ".s0")

     to = paste0(ad, ".s1")

     by = paste0(ad, ".s2")

-    length = getSizeVar(deparse(var),ind)

+    length = getSizeVar(deparse(var),1)

     data.frame(from = from, to = to, by = by, length = length, stringsAsFactors = FALSE)

 }

@@ -241,8 +265,7 @@ C_general_scalar_assignment <- function(varInfo, Exp, funcName, func) {

             stop("Unexpected function:", deparse(Exp))

         }

     } else {

-        res = R_expression_sub(varInfo, leftExp, sub = 1, sub_C = TRUE, 

-            extCode = extCode)

+        res = C_element_getCExp(varInfo, leftExp, sub = 0, extCode = extCode)

         value_left = res$value

         extCode = res$extCode

     }

@@ -257,8 +280,7 @@ C_general_scalar_assignment <- function(varInfo, Exp, funcName, func) {

             stop("Unexpected function:", deparse(Exp))

         }

     } else {

-        res = R_expression_sub(varInfo, rightExp, sub = 1, sub_C = TRUE, 

-            extCode = extCode)

+        res = C_element_getCExp(varInfo, rightExp, sub = 0, extCode = extCode)

         value_right = res$value

         extCode = res$extCode

     }

@@ -1,6 +1,7 @@

 ROptimizer1 <- function(profileMeta2) {

   previousExp=profileMeta2$Exp

   varInfo=profileMeta2$varInfo

+  #Find the start and end line number of the in used variables

   #a vector of 2: start,end

   varUsedInfo=list()

   for(i in seq_along(previousExp)){

@@ -15,12 +16,12 @@ ROptimizer1 <- function(profileMeta2) {

       }

     }

   }

-  

+  #Remove the global variable

   varUsedInfo[[GPUVar$gpu_global_id]]=NULL

   varUsedInfoTbl=do.call("rbind", varUsedInfo)

   vars=row.names(varUsedInfoTbl)

-  

+  #Add compiler.define and compiler.release information in the code

   Exp=c()

   for(i in rev(seq_along(previousExp))){

     curReleasedVarInd=which(varUsedInfoTbl[,2]==i)

@@ -53,36 +54,143 @@ ROptimizer1 <- function(profileMeta2) {

 }

-

-variableInUsed<-function(varInfo,vars){

-  res=lapply(vars,findRootVar,varInfo=varInfo)

-  unlist(res)

+ROptimizer2 <- function(GPUExp2) {

+  previousCode=GPUExp2$gpu_code

+  #Find the start and end line number of the var dimension

+  varRecord=getVarDimRecord(previousCode)

+  

+  insertCode=getDimCode(GPUExp2$varInfo,varRecord)

+  code=previousCode

+  for(i in rev(as.numeric(names(insertCode)))){

+    pre_len=i-1

+    post_len=length(code)-i

+    code=c(code[seq_len(pre_len)],insertCode[[as.character(i)]],code[seq_len(post_len)+i])

+  }

+  code=code[-which(code=="//Main function delimiter")]

+  #realize the promise assign

+  code=realizePromiseAssign(code,varRecord)

+  

+  GPUExp3=GPUExp2

+  GPUExp3$gpu_code=code

+  GPUExp3

 }

-findRootVar<-function(varInfo,Exp){

-  Exp=toExpression(Exp)

-  vars=extractVars(Exp)

-  root=c()

-  for(i in vars){

-    if(is.call(i)){

-      rootc(root,findRootVar(varInfo,i))

+

+getVarDimRecord<-function(previousCode){

+  varRecord=c()

+  mainLineNum=0

+  pattern=paste0(GPUVar$matrix_size_prefix,"(.+?)_dim_([12])")

+  for(i in seq_along(previousCode)){

+    curCode=previousCode[[i]]

+    if(curCode=="//Main function delimiter"){

+      mainLineNum=i

       next

     }

-    curvar=toCharacter(i)

-    if(hasVar(varInfo,curvar)){

-      curInfo=getVarInfo(varInfo,curvar)

-      if(curInfo$redirect!="NA"){

-        root=c(root,findRootVar(varInfo,curInfo$redirect))

+    #If it is a promise assign, skip it

+    if(length(grep(GPUVar$promiseAssgin,curCode,fixed = TRUE))!=0)

+      next

+    #find the first main function delimiter

+    if(mainLineNum==0)

+      next

+    #extract the variable dimension variables

+    dim_vars=unique(str_extract_all(curCode,pattern)[[1]])

+    #Find the target variable

+    vars=gsub(pattern,"\\1",dim_vars)

+    vars_dim_ind=gsub(pattern,"\\2",dim_vars)

+    for(j in seq_along(vars)){

+      var=vars[j]

+      var_dim_ind=vars_dim_ind[j]

+      record_Ind=which(varRecord[,1]==var&varRecord[,2]==var_dim_ind)

+      if(length(record_Ind)==1){

+        varRecord[record_Ind,4]=i

       }else{

-          if(curInfo$specialType=="ref"){

-            root=c(root,findRootVar(varInfo,curInfo$specialContent))

-          }else{

-            if(!curInfo$shared){

-              root=c(root,curInfo$var)

-            }

-         }

+        varRecord=rbind(varRecord,c(var,var_dim_ind,i,i,mainLineNum))

       }

     }

   }

-  root

-}

\ No newline at end of file

+  varRecord=as.data.frame(varRecord,stringsAsFactors=FALSE)

+  colnames(varRecord)=c("var","dim","start","end","mainLineNum")

+  varRecord

+}

+

+getDimCode<-function(varInfo,varRecord){

+  insertCode=list()

+  #tmpname,varName

+  temp_dim_record=c()

+  ind=unique(sort(c(varRecord$start)))

+  matrix_temporary_size=GPUVar$matrix_temporary_size

+  for(i in seq_len(nrow(varRecord))){

+    start_line=varRecord$start[i]

+    #Remove the unused dim

+    unused_ind=which(varRecord$end<start_line)

+    unused_var=varRecord$var[unused_ind]

+    unused_var_dim=varRecord$dim[unused_ind]

+    var_dim=getSizeVar(unused_var,unused_var_dim)

+    temp_dim_record[temp_dim_record%in%var_dim]=NA

+    

+    #Assign the size variable a temporary dim variable

+    mainLineInd=varRecord$mainLineNum[i]

+    curVar=varRecord$var[i]

+    curVar_dim=varRecord$dim[i]

+    curVar_dim_char=getSizeVar(curVar,curVar_dim)

+    #Check if there is enough temprary variables

+    #If not, add more temporary variables

+    #If it is enough, assign the temporary variables to the dim variables

+    temp_Var_def=NULL

+    tmpVar_available_size=sum(is.na(temp_dim_record))

+    if(tmpVar_available_size==0){

+      temp_dim_record=c(temp_dim_record,NA)

+      temp_Var_def=paste0(GPUVar$default_index_type," ",matrix_temporary_size,length(temp_dim_record),";")

+    }

+    tmpVar_available_ind=which(is.na(temp_dim_record))

+    tmp_ind=tmpVar_available_ind[1]

+    temp_dim_record[tmp_ind]=curVar_dim_char

+    #Define the size macro

+    dim_macro=paste0("#define ",curVar_dim_char," ",matrix_temporary_size,tmp_ind)

+    #Find the size data

+    dim_data=NULL

+    if(has.key(curVar,varInfo$matrixInd)){

+      curInfo=getVarInfo(varInfo,curVar)

+      if(curInfo$location=="global"&&curInfo$shared){

+        size_ad=paste0(GPUVar$gs_size,curVar_dim)

+      }

+      if(curInfo$location=="global"&&!curInfo$shared){

+        size_ad=paste0(GPUVar$gp_size,curVar_dim)

+      }

+      if(curInfo$location=="local"&&curInfo$shared){

+        size_ad=paste0(GPUVar$ls_size,curVar_dim)

+      }

+      if(curInfo$location=="local"&&!curInfo$shared){

+        size_ad=paste0(GPUVar$lp_size,curVar_dim)

+      }

+      dim_data=paste0(curVar_dim_char,"=",size_ad,"(",varInfo$matrixInd[[curVar]],");")

+    }

+    

+    insertCode[[mainLineInd]]=c(insertCode[[mainLineInd]],

+                                temp_Var_def,

+                                dim_macro,

+                                dim_data

+    )

+  }

+  insertCode

+}

+realizePromiseAssign<-function(code,varRecord){

+  vars_dim=getSizeVar(varRecord$var,varRecord$dim)

+  vars_dim_group=paste0(vars_dim,collapse = "|")

+  vars_dim_header=GPUVar$promiseAssgin

+  vars_dim_pattern=paste0(vars_dim_header,"(",vars_dim_group,")")

+  remove_ind=NULL

+  for(i in seq_along(code)){

+    curCode=code[i]

+    if(length(grep(vars_dim_header,curCode))>0){

+      if(length(grep(vars_dim_pattern,curCode))>0){

+        code[i]=substr(curCode,nchar(vars_dim_header)+1,nchar(curCode))

+      }else{

+        remove_ind=c(remove_ind,i)

+      }

+    }

+  }

+  if(!is.null(remove_ind))

+    code=code[-remove_ind]

+  return(code)

+}

@@ -0,0 +1,36 @@

+#######################Optimizer 1#############################

+#Find which variables are in used

+#Can handle redirect and subref

+variableInUsed<-function(varInfo,vars){

+  res=lapply(vars,findRootVar,varInfo=varInfo)

+  unlist(res)

+}

+#Find the in used variables for the current expression

+findRootVar<-function(varInfo,Exp){

+  Exp=toExpression(Exp)

+  vars=extractVars(Exp)

+  root=c()

+  for(i in vars){

+    if(is.call(i)){

+      rootc(root,findRootVar(varInfo,i))

+      next

+    }

+    curvar=toCharacter(i)

+    if(hasVar(varInfo,curvar)){

+      curInfo=getVarInfo(varInfo,curvar)

+      if(curInfo$redirect!="NA"){

+        root=c(root,findRootVar(varInfo,curInfo$redirect))

+      }else{

+        if(curInfo$specialType=="ref"){

+          root=c(root,findRootVar(varInfo,curInfo$specialContent))

+        }else{

+          if(!curInfo$shared){

+            root=c(root,curInfo$var)

+          }

+        }

+      }

+    }

+  }

+  root

+}

+#######################Optimizer 2#############################

\ No newline at end of file

@@ -175,6 +175,7 @@ profiler_assignment_exitingVar <- function(level, varInfo, curExp) {

 # curExp=quote({D=1:gpu_global_id})[[2]]

 profiler_assignment_newVar <- function(level, varInfo, curExp) {

     result=list(Exp=curExp,varInfo=varInfo)

+    

     rightInfoPack = getExpInfo(varInfo, curExp[[3]])

     rightInfo = rightInfoPack$ExpInfo

@@ -695,8 +696,8 @@ profile_transpose <- function(varInfo, Exp) {

 # Exp=quote(t_nocpy(A))

 profile_transpose_nocpy <- function(varInfo, Exp) {

     curVar = Exp[[2]]

-    Exp = parse(text = paste0("subRef(", curVar, ",,)"))[[1]]

-    info = getExpInfo(varInfo, Exp)

+    Exp_new = parse(text = paste0("subRef(", curVar, ",,)"))[[1]]

+    info = getExpInfo(varInfo, Exp_new)

     ExpInfo = info$ExpInfo

     size1 = ExpInfo$size2

     size2 = ExpInfo$size1

@@ -704,6 +705,7 @@ profile_transpose_nocpy <- function(varInfo, Exp) {

     ExpInfo$size2 = size2

     ExpInfo$transpose = !ExpInfo$transpose

     info$ExpInfo = ExpInfo

+    info$Exp=Exp

     return(info)

 }

@@ -142,6 +142,7 @@ getVarsNum <- function(extCode) {

 hoistOpt <- function(extCode, Exp) {

     code = C_to_R(Exp)

     code = vapply(expandExp(code), Simplify,character(1))

+    #code=expandExp(code)

     codeInfo = list()

     baseLevel = c()

     # Decompose the code and find the base level for each code

@@ -226,9 +227,10 @@ constructCode <- function(codeInfo, level) {

 }

 # Decompose the code into different level The code should not be able

-# to separate by +,- operator The current supported decompose function

-# is *

+# to separate by +,- operator 

+# The current supported decompose function is *

 decomposeCode <- function(extCode, code) {

+  code = toExpression(code)

     code = decomposeCode_hidden(extCode, code)

     if (nrow(code) > 1) {

         for (i in seq_len(getLevelNum(extCode) - 1)) {

@@ -241,14 +243,14 @@ decomposeCode <- function(extCode, code) {

     code

 }

 decomposeCode_hidden <- function(extCode, code, operator = "") {

-    code = toExpression(code)

-    if (is.call(code)) {

+    

+    if (is.call(code)&&operator!="/") {

         func = deparse(code[[1]])

         if (func == "*") {

-            left = decomposeCode_hidden(extCode, code[[2]])

-            right = rbind(left, decomposeCode_hidden(extCode, code[[3]], 

-                operator = func))

-            return(right)

+            left = decomposeCode_hidden(extCode, code[[2]],operator=operator)

+            right = decomposeCode_hidden(extCode, code[[3]],operator = func)

+            res=rbind(left,right)

+            return(res)

         }

         if (func == "-") {

             res = decomposeCode_hidden(extCode, code[[2]])

@@ -256,7 +258,7 @@ decomposeCode_hidden <- function(extCode, code, operator = "") {

             return(res)

         }

         if (func == "(") {

-            res = decomposeCode_hidden(extCode, code[[2]])

+            res = decomposeCode_hidden(extCode, code[[2]],operator=operator)

             return(res)

         }

     }

@@ -278,7 +280,7 @@ findCodeLevel <- function(extCode, code) {

     level = findVarLevel(extCode, vars)

     return(level)

 }

-

+#code="gpu_element_dist * (10 * gpu_element_j + gpu_element_i)"

 # Expand the parathesis in the expression

 expandExp <- function(code) {

     code = toExpression(code)

@@ -99,8 +99,8 @@ fillGPUdata <- function(GPUcode1, .options, .device) {

     kernel_args = list()

-    # gp_totalsize, return size

-    kernel_args$sizeInfo = rep(0, 2)

+    # return size, gp,gs,lp offset, gp,gs,lp,ls number, gp,gs,lp,ls dim(row,col) 

+    kernel_args$sizeInfo = NULL

     gp_totalsize=0

     returnSize=1

@@ -110,19 +110,19 @@ fillGPUdata <- function(GPUcode1, .options, .device) {

     sizeInfo_gp = getVarSizeInfo_C_level(varInfo$matrix_gp)

     # Total size per worker

-    gp_totalsize = sizeInfo_gp$totalSize

     matrix_size_info=c(matrix_size_info,sizeInfo_gp$dim)

     sizeInfo_gs = getVarSizeInfo_C_level(varInfo$matrix_gs)

     matrix_size_info=c(matrix_size_info,sizeInfo_gs$dim)

+    sizeInfo_lp = getVarSizeInfo_C_level(varInfo$matrix_lp)

+    matrix_size_info=c(matrix_size_info,sizeInfo_lp$dim)

+    

     sizeInfo_ls = getVarSizeInfo_C_level(varInfo$matrix_ls)

     matrix_size_info=c(matrix_size_info,sizeInfo_ls$dim)

-    sizeInfo_lp = getVarSizeInfo_C_level(varInfo$matrix_lp)

-    matrix_size_info=c(matrix_size_info,sizeInfo_lp$dim)

-    if(length(matrix_size_info)==0) matrix_size_info=0

+    

     if (!is.null(varInfo$returnInfo)) {

@@ -140,9 +140,10 @@ fillGPUdata <- function(GPUcode1, .options, .device) {

         }

     }

+    matrix_offset=c(sizeInfo_gp$matrixOffset,sizeInfo_gs$matrixOffset,sizeInfo_ls$matrixOffset)

+    kernel_args$sizeInfo = c(returnSize,matrix_offset,matrix_size_info)

-    kernel_args$sizeInfo = c(gp_totalsize,returnSize)

-    

+    if(length(matrix_size_info)==0) matrix_size_info=0

     # Allocate the gpu memory

     totalWorkerNum = length(parms[[1]])

     IntType = GPUVar$default_index_type

@@ -155,16 +156,6 @@ fillGPUdata <- function(GPUcode1, .options, .device) {

     device_argument$ls_data = kernel.getSharedMem(sizeInfo_ls$totalSize, 

                                                   type = "char")

-    device_argument$gp_offset = gpuMatrix(sizeInfo_gp$matrixOffset, type = IntType, 

-                                          device = .device)

-    device_argument$gs_offset = gpuMatrix(sizeInfo_gs$matrixOffset, type = IntType, 

-                                          device = .device)

-    device_argument$ls_offset = gpuMatrix(sizeInfo_ls$matrixOffset, type = IntType, 

-                                          device = .device)

-    

-    device_argument$matrix_size_info = gpuMatrix(matrix_size_info, type = IntType, 

-                                        device = .device)

-    

     # The return size for each thread

     device_argument$return_var = gpuEmptMatrix(returnSize, totalWorkerNum, type = GPUVar$default_float, device = .device)

@@ -11,9 +11,30 @@ GPUVar <- local({

     #gpu size prefix

-    GPUVar_env$matrix_size_prefix="gpu_size_of_"

+    GPUVar_env$matrix_size_prefix="gpu_"

+    GPUVar_env$matrix_temporary_size="gpu_matrix_temporary_size"

+    GPUVar_env$promiseAssgin="//compiler promise assign:"

+    #Matrix number

+    GPUVar_env$gp_number="gpu_gp_number"

+    GPUVar_env$gs_number="gpu_gs_number"

+    GPUVar_env$lp_number="gpu_lp_number"

+    GPUVar_env$ls_number="gpu_ls_number"

+    

+    

+    #This is the offset to find the data in the function argument

+    #It is a macro

+    GPUVar_env$global_private_offset="gpu_gp_offset"

+    GPUVar_env$global_shared_offset="gpu_gs_offset"

+    GPUVar_env$local_shared_offset="gpu_ls_offset"

+    

+    #The macro that find the gp,gs,lp,ls size

+    GPUVar_env$gp_size="gpu_gp_size"

+    GPUVar_env$gs_size="gpu_gs_size"

+    GPUVar_env$lp_size="gpu_lp_size"

+    GPUVar_env$ls_size="gpu_ls_size"

+    

     # matrix size info

@@ -21,37 +42,22 @@ GPUVar <- local({

     GPUVar_env$global_share_size = "gpu_gs_size_arg"

     GPUVar_env$local_share_size = "gpu_ls_size_arg"

-    # matrix dimension info 

-    # the order is gp_size1,gp_size2,gs~,lp~,ls~