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,default)
S3method(ts_compile,ts_function)
S3method(ts_compile,ts_overload)
export(is_overload)
export(ts_character)
export(ts_compile)
export(ts_dataframe)
@ -15,4 +13,3 @@ export(ts_integer)
export(ts_list)
export(ts_logical)
export(ts_numeric)
export(ts_overload)

View File

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

View File

@ -25,16 +25,17 @@ ts_function <- function(f, ..., result = NULL) {
if (!is.null(result) && !is_object(result)) {
stop("Invalid return type")
}
if (any(is_overload(args))) {
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)))
})
class(z) <- "ts_overload"
return(z)
}
# TODO: implement overloads, if possible with zod
# if (any(is_overload(args))) {
# 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)))
# })
# class(z) <- "ts_overload"
# return(z)
# }
fn <- function(...) {
mc <- match.call(f)
@ -47,14 +48,14 @@ ts_function <- function(f, ..., result = NULL) {
fn
}
#' @export
is_overload <- function(x) {
sapply(x, inherits, what = "ts_overload")
}
# #' @export
# is_overload <- function(x) {
# sapply(x, inherits, what = "ts_overload")
# }
#' @export
ts_overload <- function(..., result = NULL) {
structure(list(args = list(...), result = result),
class = "ts_overload"
)
}
# #' @export
# ts_overload <- function(..., result = NULL) {
# structure(list(args = list(...), result = result),
# class = "ts_overload"
# )
# }

View File

@ -27,8 +27,8 @@ object <- function(type = "any",
#' @export
print.ts_object <- function(x, ...) {
# name <- deparse(substitute(x))
cat(sprintf("Object: %s\n", x$type))
cat(sprintf("rserve-ts type: %s\n", x$type_fn))
cat(sprintf("Input (ts) type: %s\n", x$type))
cat(sprintf("Output (R) type: %s\n", x$type_fn))
}
is_object <- function(x) {
@ -36,7 +36,15 @@ is_object <- function(x) {
}
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)) {
if (n == 1) {
@ -51,14 +59,14 @@ n_type_fun <- function(n, type) {
if (n < 0) {
return(type)
}
sprintf("%s<%s>)", type, n)
sprintf("%s(%s)", type, n)
}
#' @export
ts_logical <- function(n = -1L) {
object(
n_type(n, "boolean"),
n_type_fun(n, "RTYPE.Logical"),
n_type_fun(n, "RTYPE.logical"),
check = function(x) {
if (!is.logical(x)) stop("Expected a boolean")
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) {
object(
n_type(n, "number"),
n_type_fun(n, "RTYPE.Integer"),
n_type_fun(n, "RTYPE.integer"),
check = function(x) {
if (!is.integer(x)) stop("Expected an integer")
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) {
object(
n_type(n, "number"),
n_type_fun(n, "RTYPE.Numeric"),
n_type_fun(n, "RTYPE.numeric"),
check = function(x) {
if (!is.numeric(x)) stop("Expected a number", call. = FALSE)
if (n > 0 && length(x) != n) {
@ -99,7 +107,7 @@ ts_numeric <- function(n = -1L) {
ts_character <- function(n = -1L) {
object(
n_type(n, "string"),
n_type_fun(n, "RTYPE.Character"),
n_type_fun(n, "RTYPE.character"),
check = function(x) {
if (!is.character(x)) stop("Expected a string")
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)
#> )
#>
#> sample_one <- ts_function(
#> sample_num <- ts_function(
#> sample,
#> ts_overload(
#> x = ts_numeric(),
#> result = ts_numeric(1)
#> ),
#> ts_overload(
#> x = ts_character(),
#> result = ts_character(1)
#> )
#> x = ts_numeric(0),
#> result = ts_numeric(1)
#> )
ts_compile("tests/testthat/app.R", file = "")
#> import type { Character, Numeric } from 'rserve-ts';
#>
#> 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>)>;
#> Error in ts_compile.ts_function(e[[x]], file = file, name = x): unused argument (file = file)
```
## TODO

View File

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

View File

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