handle vector inputs, drop overloads

This commit is contained in:
Tom Elliott 2024-10-02 17:27:50 +13:00
parent c65ac9c3a1
commit b2e62d757f
7 changed files with 61 additions and 79 deletions

View File

@ -4,8 +4,6 @@ S3method(print,ts_object)
S3method(ts_compile,character) S3method(ts_compile,character)
S3method(ts_compile,default) S3method(ts_compile,default)
S3method(ts_compile,ts_function) S3method(ts_compile,ts_function)
S3method(ts_compile,ts_overload)
export(is_overload)
export(ts_character) export(ts_character)
export(ts_compile) export(ts_compile)
export(ts_dataframe) export(ts_dataframe)
@ -15,4 +13,3 @@ export(ts_integer)
export(ts_list) export(ts_list)
export(ts_logical) export(ts_logical)
export(ts_numeric) export(ts_numeric)
export(ts_overload)

View File

@ -1,6 +1,6 @@
#' @export #' @export
ts_compile <- function(f, ..., file = NULL) { ts_compile <- function(f, ..., file = NULL) {
UseMethod("ts_compile") o <- UseMethod("ts_compile")
} }
#' @export #' @export
@ -9,17 +9,17 @@ ts_compile.ts_function <- function(f, name = deparse(substitute(f)), ...) {
result <- attr(f, "result") result <- attr(f, "result")
inputs <- sapply(inputs, \(x) x$type) inputs <- sapply(inputs, \(x) x$type)
fn_args <- paste(names(inputs), inputs, sep = ": ") |> fn_args <- paste(inputs) |>
paste(collapse = ", ") paste(collapse = ", ")
sprintf("const %s = (%s) => Promise<%s>;", name, fn_args, result$type_fn) sprintf("const %s = R.ocap([%s], %s]);", name, fn_args, result$type_fn)
} }
#' @export # #' @export
ts_compile.ts_overload <- function(f, file = NULL, name = deparse(substitute(f))) { # ts_compile.ts_overload <- function(f, file = NULL, name = deparse(substitute(f))) {
cmt <- sprintf("\n// %s overloads", name) # cmt <- sprintf("\n// %s overloads", name)
oloads <- sapply(f, ts_compile, name = name) # oloads <- sapply(f, ts_compile, name = name)
paste(cmt, paste(oloads, collapse = "\n"), sep = "\n") # paste(cmt, paste(oloads, collapse = "\n"), sep = "\n")
} # }
#' @export #' @export
ts_compile.character <- function( ts_compile.character <- function(
@ -49,7 +49,7 @@ ts_compile.character <- function(
cat( cat(
sprintf( sprintf(
"import type { %s } from 'rserve-ts';\n\n", "import { %s } from 'rserve-ts';\n\n",
paste(types, collapse = ", ") paste(types, collapse = ", ")
), ),
file = file file = file

View File

@ -25,16 +25,17 @@ ts_function <- function(f, ..., result = NULL) {
if (!is.null(result) && !is_object(result)) { if (!is.null(result) && !is_object(result)) {
stop("Invalid return type") stop("Invalid return type")
} }
if (any(is_overload(args))) { # TODO: implement overloads, if possible with zod
if (!all(is_overload(args))) { # if (any(is_overload(args))) {
stop("Cannot mix overloads with standard arguments") # if (!all(is_overload(args))) {
} # stop("Cannot mix overloads with standard arguments")
z <- lapply(args, function(x) { # }
do.call(ts_function, c(list(f), x$args, list(result = x$result))) # z <- lapply(args, function(x) {
}) # do.call(ts_function, c(list(f), x$args, list(result = x$result)))
class(z) <- "ts_overload" # })
return(z) # class(z) <- "ts_overload"
} # return(z)
# }
fn <- function(...) { fn <- function(...) {
mc <- match.call(f) mc <- match.call(f)
@ -47,14 +48,14 @@ ts_function <- function(f, ..., result = NULL) {
fn fn
} }
#' @export # #' @export
is_overload <- function(x) { # is_overload <- function(x) {
sapply(x, inherits, what = "ts_overload") # sapply(x, inherits, what = "ts_overload")
} # }
#' @export # #' @export
ts_overload <- function(..., result = NULL) { # ts_overload <- function(..., result = NULL) {
structure(list(args = list(...), result = result), # structure(list(args = list(...), result = result),
class = "ts_overload" # class = "ts_overload"
) # )
} # }

View File

@ -27,8 +27,8 @@ object <- function(type = "any",
#' @export #' @export
print.ts_object <- function(x, ...) { print.ts_object <- function(x, ...) {
# name <- deparse(substitute(x)) # name <- deparse(substitute(x))
cat(sprintf("Object: %s\n", x$type)) cat(sprintf("Input (ts) type: %s\n", x$type))
cat(sprintf("rserve-ts type: %s\n", x$type_fn)) cat(sprintf("Output (R) type: %s\n", x$type_fn))
} }
is_object <- function(x) { is_object <- function(x) {
@ -36,7 +36,15 @@ is_object <- function(x) {
} }
ts_union <- function(...) paste(..., sep = " | ") ts_union <- function(...) paste(..., sep = " | ")
ts_array <- function(type) paste(type, "[]", sep = "") ts_array <- function(type = c("number", "boolean", "string")) {
if (type == "number") {
return("Float64Array")
}
if (type == "boolean") {
return("Uint8Array")
}
return("RTYPE.stringArray")
}
n_type <- function(n, type, pl = ts_array(type)) { n_type <- function(n, type, pl = ts_array(type)) {
if (n == 1) { if (n == 1) {
@ -51,14 +59,14 @@ n_type_fun <- function(n, type) {
if (n < 0) { if (n < 0) {
return(type) return(type)
} }
sprintf("%s<%s>)", type, n) sprintf("%s(%s)", type, n)
} }
#' @export #' @export
ts_logical <- function(n = -1L) { ts_logical <- function(n = -1L) {
object( object(
n_type(n, "boolean"), n_type(n, "boolean"),
n_type_fun(n, "RTYPE.Logical"), n_type_fun(n, "RTYPE.logical"),
check = function(x) { check = function(x) {
if (!is.logical(x)) stop("Expected a boolean") if (!is.logical(x)) stop("Expected a boolean")
if (n > 0 && length(x) != n) stop("Expected a boolean of length ", n) if (n > 0 && length(x) != n) stop("Expected a boolean of length ", n)
@ -71,7 +79,7 @@ ts_logical <- function(n = -1L) {
ts_integer <- function(n = -1L) { ts_integer <- function(n = -1L) {
object( object(
n_type(n, "number"), n_type(n, "number"),
n_type_fun(n, "RTYPE.Integer"), n_type_fun(n, "RTYPE.integer"),
check = function(x) { check = function(x) {
if (!is.integer(x)) stop("Expected an integer") if (!is.integer(x)) stop("Expected an integer")
if (n > 0 && length(x) != n) stop("Expected an integer of length ", n) if (n > 0 && length(x) != n) stop("Expected an integer of length ", n)
@ -84,7 +92,7 @@ ts_integer <- function(n = -1L) {
ts_numeric <- function(n = -1L) { ts_numeric <- function(n = -1L) {
object( object(
n_type(n, "number"), n_type(n, "number"),
n_type_fun(n, "RTYPE.Numeric"), n_type_fun(n, "RTYPE.numeric"),
check = function(x) { check = function(x) {
if (!is.numeric(x)) stop("Expected a number", call. = FALSE) if (!is.numeric(x)) stop("Expected a number", call. = FALSE)
if (n > 0 && length(x) != n) { if (n > 0 && length(x) != n) {
@ -99,7 +107,7 @@ ts_numeric <- function(n = -1L) {
ts_character <- function(n = -1L) { ts_character <- function(n = -1L) {
object( object(
n_type(n, "string"), n_type(n, "string"),
n_type_fun(n, "RTYPE.Character"), n_type_fun(n, "RTYPE.character"),
check = function(x) { check = function(x) {
if (!is.character(x)) stop("Expected a string") if (!is.character(x)) stop("Expected a string")
if (n > 0 && length(x) != n) stop("Expected a string of length ", n) if (n > 0 && length(x) != n) stop("Expected a string of length ", n)

View File

@ -106,27 +106,14 @@ cat(readLines("tests/testthat/app.R"), sep = "\n")
#> x = ts_character(-1), result = ts_character(1) #> x = ts_character(-1), result = ts_character(1)
#> ) #> )
#> #>
#> sample_one <- ts_function( #> sample_num <- ts_function(
#> sample, #> sample,
#> ts_overload( #> x = ts_numeric(0),
#> x = ts_numeric(), #> result = ts_numeric(1)
#> result = ts_numeric(1)
#> ),
#> ts_overload(
#> x = ts_character(),
#> result = ts_character(1)
#> )
#> ) #> )
ts_compile("tests/testthat/app.R", file = "") ts_compile("tests/testthat/app.R", file = "")
#> import type { Character, Numeric } from 'rserve-ts'; #> Error in ts_compile.ts_function(e[[x]], file = file, name = x): unused argument (file = file)
#>
#> const fn_first = (x: string | string[]) => Promise<Character<1>)>;
#> const fn_mean = (x: number | number[]) => Promise<Numeric<1>)>;
#>
#> // sample_one overloads
#> const sample_one = (x: number | number[]) => Promise<Numeric<1>)>;
#> const sample_one = (x: string | string[]) => Promise<Character<1>)>;
``` ```
## TODO ## TODO

View File

@ -5,14 +5,8 @@ fn_first <- ts_function(function(x) x[1],
x = ts_character(-1), result = ts_character(1) x = ts_character(-1), result = ts_character(1)
) )
sample_one <- ts_function( sample_num <- ts_function(
sample, sample,
ts_overload( x = ts_numeric(0),
x = ts_numeric(), result = ts_numeric(1)
result = ts_numeric(1)
),
ts_overload(
x = ts_character(),
result = ts_character(1)
)
) )

View File

@ -1,17 +1,12 @@
# overload input/return types # overload input/return types
sample_one <- ts_function( sample_num <- ts_function(
sample, sample,
ts_overload( x = ts_numeric(0),
x = ts_numeric(), result = ts_numeric(1)
result = ts_numeric(1)
),
ts_overload(
x = ts_character(),
result = ts_character(1)
)
) )
ts_compile(sample_one) ts_compile(sample_num)
# compile to: # compile to:
# const sample_one = (x: number) => Promise<number>; # const out = {
# const sample_one = (x: string) => Promise<string>; # sample_one: R.ocap([R.as_vector(z.number())], R.numeric(1)),
# };