More complete runtime

runtimes/r/runtime.R

@@ -12,10 +12,6 @@ setMethod("Ops", "catala_integer", function(e1, e2) {
   new("catala_integer", v = v)
 })
 
-as.catala_integer <- function(x) {
-  catala_integer(v = as.bigz(x))
-}
-
 ################ Decimals #################
 
 catala_decimal <- setClass(
@@ -26,12 +22,6 @@ setMethod("Ops", "catala_decimal", function(e1, e2) {
   v <- callGeneric(e1@v, e2@v)
   new("catala_decimal", v = v)
 })
-as.catala_decimal <- function(x) {
-  catala_decimal(v = as.bigq(x))
-}
-
-
-
 
 ################ Money #################
 catala_money <- setClass(
@@ -54,12 +44,6 @@ setMethod("Compare", "catala_money", function(e1, e2) {
   v <- callGeneric(e1@v, e2@v)
   new("catala_money", v = v)
 })
-as.catala_money_units <- function(x) {
-  catala_money(v = as.bigz(x) * as.bigz(100))
-}
-as.catala_money_cents <- function(x) {
-  catala_money(v = as.bigz(x))
-}
 
 ################ Duration #################
 catala_duration <- suppressWarnings(setClass(
@@ -79,9 +63,10 @@ setMethod("Compare", "catala_duration", function(e1, e2) {
   v <- callGeneric(e1@v, e2@v)
   new("catala_duration", v = v)
 })
-as.catala_duration_ymd <- function(y, m, d) {
-  catala_duration(v = years(y) + months(m) + days(d))
-}
+
+
+# TODO: port the dates_calc library to R to make date computations
+# more robust.
 
 ################ Dates #################
 catala_date <- setClass(
@@ -98,11 +83,136 @@ setMethod("Compare", "catala_date", function(e1, e2) {
   v <- callGeneric(e1@v, e2@v)
   new("catala_date", v = v)
 })
-as.catala_date_ymd <- function(y, m, d) {
+
+################ Unit #################
+
+catala_unit <- setClass("catala_unit")
+
+################ Constructors and conversions #################
+
+# Money
+
+catala_money_from_units <- function(x) {
+  catala_money(v = as.bigz(x) * as.bigz(100))
+}
+catala_money_from_cents <- function(x) {
+  catala_money(v = as.bigz(x))
+}
+catala_money_from_decimal <- function(d) {
+  num_cents_q <- abs(d@v * as.bigq(100))
+  unit_part_num_cents_z <- as.bigz(num_cents_q)
+  remainder_q <- num_cents_q - as.bigq(unit_part_num_cents_z)
+  if (remainder_q < as.bigq(0.5)) {
+    catala_money(v = as.bigz(sign(d@v)) * unit_part_num_cents_z)
+  } else {
+    catala_money(v = as.bigz(sign(d@v)) * (unit_part_num_cents_z + as.bigz(1)))
+  }
+}
+catala_money_to_numeric <- function(m) {
+  as.numeric(as.bigq(m@v) / as.bigq(100))
+}
+catala_money_to_string <- function(m) {
+  paste0("$", catala_money_to_numeric(m))
+}
+catala_money_round <- function(m) {
+  q <- abs(m@v) %/% as.bigz(100)
+  r <- abs(m@v) %% as.bigz(100)
+  if (abs(r) < 50) {
+    catala_money(v = sign(m@v) * q * as.bigz(100))
+  } else {
+    catala_money(v = sign(m@v) * (q + 1) * as.bigz(100))
+  }
+}
+
+
+# Decimals
+
+catala_decimal_from_numeric <- function(x) {
+  catala_decimal(v = as.bigq(x))
+}
+
+catala_decimal_from_string <- function(x) {
+  catala_decimal(v = as.bigq(x))
+}
+
+catala_decimal_from_integer <- function(x) {
+  catala_decimal(v = as.bigq(x@v))
+}
+
+catala_decimal_to_numeric <- function(x) {
+  as.numeric(x@v)
+}
+catala_decimal_round <- function(d) {
+  q <- abs(as.bigq(as.bigz(d@v)))
+  r <- abs(d@v) - as.bigq(q)
+  if (r < as.bigq(0.5)) {
+    catala_decimal(v = sign(d@v) * q)
+  } else {
+    catala_decimal(v = sign(d@v) * (q + as.bigq(1)))
+  }
+}
+catala_decimal_from_money <- function(m) {
+  catala_decimal(v = as.bigq(as.bigq(m@v) / as.bigq(100)))
+}
+
+# Integers
+
+catala_integer_from_numeric <- function(x) {
+  catala_integer(v = as.bigz(x))
+}
+catala_integer_from_string <- function(x) {
+  catala_integer(v = as.bigz(x))
+}
+catala_integer_to_numeric <- function(x) {
+  as.numeric(x@v)
+}
+
+# Dates
+
+catala_date_from_ymd <- function(y, m, d) {
   catala_date(v = make_date(year = y, month = m, day = d))
 }
 
-################ Lists #################
+catala_day_of_month_of_date <- function(d) {
+  mday(d@v)
+}
+
+catala_month_number_of_date <- function(d) {
+  month(d@v)
+}
+
+catala_year_of_date <- function(d) {
+  year(d@v)
+}
+
+catala_date_to_string <- function(d) {
+  paste0(d@v)
+}
+
+catala_date_first_day_of_month <- function(d) {
+  catala_date(v = make_date(year = year(d@v), month = month(d@v), day = 1))
+}
+
+catala_date_last_day_of_month <- function(d) {
+  catala_date(v = make_date(
+    year = year(d@v),
+    month = month(d@v),
+    day = days_in_month(d@v)
+  ))
+}
+
+
+# Durations
+
+catala_duration_from_ymd <- function(y, m, d) {
+  catala_duration(v = years(y) + months(m) + days(d))
+}
+
+catala_duration_to_ymd <- function(d) {
+  c(d@v@year, d@v@month, d@v@day)
+}
+
+# List
 
 catala_list_fold_left <- function(f, init, l) {
   Reduce(f, l, init)
@@ -124,7 +234,11 @@ catala_list_reduce <- function(f, default, l) {
   }
 }
 
-################ Defaults #################
+catala_list_length <- function(l) {
+  catala_integer_from_numeric(length(l))
+}
+
+################ Exceptions #################
 
 catala_position <- setClass(
   "catala_position",
@@ -171,7 +285,14 @@ catala_no_value_provided_error <- function(pos) {
   )
 }
 
-catala_unit <- setClass("catala_unit")
+catala_assertion_failure <- function(pos) {
+  structure(
+    class = c("catala_assertion_failure", "error", "condition"),
+    list(message = catala_position_to_string(pos), call = sys.call(-1))
+  )
+}
+
+################ Defaults #################
 
 catala_handle_default <- function(pos, exceptions, just, cons) {
   acc <- Reduce(function(acc, exception) {