Add ability to see symbolTables and type annotations

nCompiler/R/cppDefs_nClass.R

@@ -200,6 +200,20 @@ cpp_nClassClass <- R6::R6Class(
         }
       }
     },
+    showTypes = function(annotations = FALSE) {
+      if(!annotations) {
+        cat("----------------- Class variables ---------------------------\n")
+        print(self$Compiler$symbolTable, parent = FALSE)
+      }
+      sapply(self$memberCppDefs, function(def) {
+        if(inherits(def, "cpp_nFunctionClass")) {
+          suffix <- paste0(rep("-", max(42-nchar(def$name), 5)), collapse = "")    
+          cat("----------------- ", def$name, " ", suffix, "\n", sep = "")
+          def$showTypes(annotations)
+        }
+      })
+      invisible(self)
+    },
     process_inheritance = function(Compiler) {
       for(oneInheritance in Compiler$compileInfo$inherit) {
         self$addInheritance(oneInheritance)

nCompiler/R/cppDefs_nFunction.R

@@ -82,6 +82,12 @@ cpp_nFunctionClass <- R6::R6Class(
       ## nCompiler_plugin()$includes already have #include, so they go here
       super$initialize(...)
     },
+    showTypes = function(annotations = FALSE) {
+      if(annotations) {
+        print(self$code$code, showType = TRUE)
+      } else print(self$NF_Compiler$symbolTable, parent = FALSE)
+      invisible(self)
+    },
     getInternalDefs = function() {
       super$getInternalDefs()
     },

nCompiler/R/nCompile.R

@@ -334,8 +334,23 @@ nCompile <- function(...,
     }
   }
 
-  if(isTRUE(controlFull$return_cppDefs)) return(cppDefs)
+  if(isTRUE(controlFull$show_types)) 
+      sapply(cppDefs, function(def) {
+          nm <- def$name
+          cat("================= ", nm, " ", paste0(rep("=", 42-nchar(nm)), collapse = ''), "\n", sep = '')
+          def$showTypes()
+          cat("\n")
+      })
+  if(isTRUE(controlFull$show_annotations)) 
+      sapply(cppDefs, function(def) {
+          nm <- def$name
+          cat("================= ", nm, " ", paste0(rep("=", 42-nchar(nm)), collapse = ''), "\n", sep = '')
+          def$showTypes(annotations = TRUE)
+          cat("\n")
+      })
 
+  if(isTRUE(controlFull$return_cppDefs)) return(cppDefs)
+
   # writePackage inserts roxygen here
 
   # (3) Create RcppPacket_list

nCompiler/R/symbolTableClass.R

@@ -124,11 +124,11 @@ symbolTableClass <-
         return(parentST),
       setParentST = function(ST)
         parentST <<- ST,
-      print = function() {
+      print = function(parent = TRUE) {
         writeLines('symbol table:')
         for(i in seq_along(symbols))
           symbols[[i]]$print()
-        if(!is.null(parentST)) {
+        if(!is.null(parentST) && parent) {
           writeLines('parent symbol table:')
           parentST$print()
         }

nCompiler/tests/testthat/nCompile_tests/test-nCompile.R

@@ -902,3 +902,55 @@ test_that("argument name mangling and argument ordering work together", {
   expect_equal(bar2(1.2,TRUE), dnorm(1.2,0,1,TRUE))
   expect_equal(comp2$bar2(1.2,TRUE), dnorm(1.2,0,1,TRUE))
 })
+
+test_that("showing types works", {
+    test <- nFunction(
+        name = "test",
+        fun = function(x = double(0),
+                       y = double(0)) {
+            tmp <- nRep(1,7)
+            tmp2 <- nMatrix(0, 5 ,3)
+        }
+    )
+    defs <- nCompile(test, control = list(return_cppDefs=TRUE))
+    expect_output(defs[[1]]$showTypes(), "symbol table")
+    expect_output(defs[[1]]$showTypes(annotations=TRUE), "{ |", fixed = TRUE) 
+
+    expect_output(defs <- nCompile(test, control =
+                 list(return_cppDefs=TRUE, show_types = TRUE, show_annotations = TRUE)),
+                 "symbol table") 
+
+    nc <- nClass(
+        Cpublic = list(
+            x = double(1),
+            add_vectors = nFunction(
+                name ='add_vectors',
+                fun = function(x = double(1),
+                               y = double(1)) {
+                    returnType(double(1))
+                    ans <- x + y
+                    return(ans)
+                }
+            ),
+            foo = nFunction(
+                fun = function(x = double(0)) {
+                    y <- nRep(1,2)
+                    z <- x + y
+                }
+            )
+        )
+    )
+    defs <- nCompile(nc, control = list(return_cppDefs=TRUE))
+    expect_output(defs[[1]]$showTypes(), "Class variables")
+    expect_output(defs[[1]]$showTypes(annotations=TRUE), "-- add_vectors --") 
+
+    expect_output(defs <- nCompile(nc, control =
+                  list(return_cppDefs=TRUE, show_types = TRUE, show_annotations = TRUE)),
+                  "Class variables")
+
+    ## Multi-unit compilation.
+    expect_output(defs <- nCompile(nc, test, control =
+                  list(return_cppDefs=TRUE, show_types = TRUE, show_annotations = TRUE)),
+                  "==== nClass_1 ====")
+
+})