HenrikBengtsson / R.rsp
1
###########################################################################/**
2
# @RdocClass RspSourceCodeFactory
3
#
4
# @title "The RspSourceCodeFactory class"
5
#
6
# \description{
7
#  @classhierarchy
8
#
9
#  An RspSourceCodeFactory is language-specific engine that knows how to translate
10
#  individual @see "RspExpression":s into source code of a specific
11
#  programming language.
12
# }
13
#
14
# @synopsis
15
#
16
# \arguments{
17
#   \item{language}{A @character string.}
18
#   \item{...}{Not used.}
19
# }
20
#
21
# \section{Fields and Methods}{
22
#  @allmethods
23
# }
24
#
25
# @author
26
#
27
# @keyword internal
28
#*/###########################################################################
29
setConstructorS3("RspSourceCodeFactory", function(language=NA, ...) {
30 1
  language <- Arguments$getCharacter(language)
31 1
  extend(language, "RspSourceCodeFactory")
32
})
33

34

35
#########################################################################/**
36
# @RdocMethod getLanguage
37
#
38
# @title "Gets the language"
39
#
40
# \description{
41
#  @get "title".
42
# }
43
#
44
# @synopsis
45
#
46
# \arguments{
47
#   \item{...}{Not used.}
48
# }
49
#
50
# \value{
51
#  Returns an @character string.
52
# }
53
#
54
# @author
55
#
56
# \seealso{
57
#   @seeclass
58
# }
59
#*/#########################################################################
60
setMethodS3("getLanguage", "RspSourceCodeFactory", function(this, ...) {
61 1
  as.character(this)
62
})
63

64

65
#########################################################################/**
66
# @RdocMethod makeSourceCode
67
#
68
# @title "Makes a RspSourceCode object"
69
#
70
# \description{
71
#  @get "title".
72
# }
73
#
74
# @synopsis
75
#
76
# \arguments{
77
#   \item{code}{A @character @vector of code strings.}
78
#   \item{...}{Arguments passed to the language-specific
79
#      @see "RspSourceCode" constructor, e.g.
80
#      \code{type} and \code{metadata}.}
81
# }
82
#
83
# \value{
84
#  Returns a @see "RspSourceCode" object.
85
# }
86
#
87
# @author
88
#
89
# \seealso{
90
#   @seeclass
91
# }
92
#*/#########################################################################
93
setMethodS3("makeSourceCode", "RspSourceCodeFactory", function(this, code, ...) {
94 1
  lang <- getLanguage(this)
95 1
  className <- sprintf("Rsp%sSourceCode", capitalize(lang))
96 1
  ns <- getNamespace("R.rsp")
97 1
  clazz <- Class$forName(className, envir=ns)
98 1
  code <- clazz(code, ...)
99

100
  # Get source code header, body, and footer.
101 1
  code <- getCompleteCode(this, code, ...)
102 1
  code <- c(code$header, code$body, code$footer)
103

104
  # Made code object
105 1
  code <- clazz(code, ...)
106

107 1
  code
108
}, protected=TRUE)
109

110

111

112

113
#########################################################################/**
114
# @RdocMethod exprToCode
115
# @alias exprToCode.RspRSourceCodeFactory
116
# @alias exprToCode.RspShSourceCodeFactory
117
#
118
# @title "Translates an RspExpression into source code"
119
#
120
# \description{
121
#  @get "title".
122
# }
123
#
124
# @synopsis
125
#
126
# \arguments{
127
#   \item{expr}{An @see "RspExpression".}
128
#   \item{...}{Not used.}
129
# }
130
#
131
# \value{
132
#  Returns a @character @vector.
133
# }
134
#
135
# @author
136
#
137
# \seealso{
138
#   @seeclass
139
# }
140
#*/#########################################################################
141
setMethodS3("exprToCode", "RspSourceCodeFactory", abstract=TRUE)
142

143

144

145

146
#########################################################################/**
147
# @RdocMethod getCompleteCode
148
# @alias getCompleteCode.RspRSourceCodeFactory
149
#
150
# @title "Gets the source code header, body, and footer"
151
#
152
# \description{
153
#  @get "title".
154
# }
155
#
156
# @synopsis
157
#
158
# \arguments{
159
#   \item{...}{Not used.}
160
# }
161
#
162
# \value{
163
#  Returns a @character string.
164
# }
165
#
166
# @author
167
#
168
# \seealso{
169
#   @seeclass
170
# }
171
#*/#########################################################################
172
setMethodS3("getCompleteCode", "RspSourceCodeFactory", function(this, object, ...) {
173
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
174
  # Validate arguments
175
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
176
  # Argument 'object':
177 1
  object <- Arguments$getInstanceOf(object, "RspSourceCode")
178 1
  lang <- getLanguage(this)
179 1
  className <- sprintf("Rsp%sSourceCode", capitalize(lang))
180 1
  object <- Arguments$getInstanceOf(object, className)
181

182

183
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
184
  # Create header and footer code
185
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
186
  # Default header and footer
187 1
  header <- ''
188 1
  footer <- ''
189

190

191
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
192
  # Merge all code
193
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
194 1
  list(header=header, body=object, footer=footer)
195
}, protected=TRUE) # getCompleteCode()
196

197

198

199
#########################################################################/**
200
# @RdocMethod toSourceCode
201
#
202
# @title "Translates an RSP document to source code"
203
#
204
# \description{
205
#  @get "title".
206
# }
207
#
208
# @synopsis
209
#
210
# \arguments{
211
#   \item{expr}{An @see "RspDocument" that has been preprocessed
212
#               and flattened.}
213
#   \item{...}{Not used.}
214
# }
215
#
216
# \value{
217
#  Returns the generated source code as a @see "RspSourceCode" object.
218
# }
219
#
220
# @author
221
#
222
# \seealso{
223
#   @seeclass
224
# }
225
#*/#########################################################################
226
setMethodS3("toSourceCode", "RspSourceCodeFactory", function(object, doc, ...) {
227
  # Argument 'doc':
228 1
  doc <- Arguments$getInstanceOf(doc, "RspDocument")
229

230 1
  if (length(doc) == 0L) {
231 0
    code <- makeSourceCode(object, "", ..., type=getType(doc), metadata=getMetadata(doc, local=TRUE))
232 0
    return(code)
233
  }
234

235
  # Assert that the RspDocument 'doc' contains no RspDocument:s
236 1
  if (any(sapply(doc, FUN=inherits, "RspDocument"))) {
237 0
    throw(sprintf("%s argument 'doc' contains other RspDocuments, which indicates that it has not been flattened.", class(doc)[1L]))
238
  }
239

240
  # Assert that the RspDocument 'doc' contains no RspDirective:s
241 1
  if (any(sapply(doc, FUN=inherits, "RspDirective"))) {
242 0
    throw(sprintf("%s argument 'doc' contains RSP preprocessing directives, which indicates that it has not been preprocessed.", class(doc)[1L]))
243
  }
244

245
  # Assert that 'doc' contains only RspText:s and RspExpression:s
246 1
  nok <- sapply(doc, FUN=function(expr) {
247 1
    if (inherits(expr, "RspText") || inherits(expr, "RspExpression")) {
248 1
      NA
249
    } else {
250 0
      class(expr)
251
    }
252
  })
253 1
  nok <- nok[!is.na(nok)]
254 1
  nok <- unique(nok)
255 1
  if (length(nok) > 0L) {
256 0
    throw(sprintf("%s argument 'doc' contains RSP preprocessing directives, which indicates that it has not been preprocessed: %s", class(doc)[1L], hpaste(nok)))
257
  }
258

259
  # Unescape RspText
260 1
  isText <- sapply(doc, FUN=inherits, "RspText")
261 1
  doc[isText] <- lapply(doc[isText], FUN=function(expr) {
262 1
    RspText(getContent(expr, unescape=TRUE))
263
  })
264

265
  # Coerce all RspConstruct:s to source code
266 1
  code <- vector("list", length=length(doc))
267 1
  for (kk in seq_along(doc)) {
268 1
    code[[kk]] <- exprToCode(object, doc[[kk]], index=kk)
269
  }
270 1
  code <- unlist(code, use.names=FALSE)
271

272 1
  code <- makeSourceCode(object, code, ..., type=getType(doc), metadata=getMetadata(doc, local=TRUE))
273

274 1
  code
275
}) # toSourceCode()

Read our documentation on viewing source code .

Loading