CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Last fixes

Browse Source
This commit is contained in:
Denis Merigoux 2023-08-07 17:55:04 +02:00
parent 8743b73459
commit 6d7b1f2585
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
3 changed files with 58 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/scalc/to_r.ml
View File

@ -32,12 +32,20 @@ let format_lit (fmt : Format.formatter) (l : lit Mark.pos) : unit =
else
Format.fprintf fmt "catala_integer_from_string(\"%s\")"
(Runtime.integer_to_string i)
| LUnit -> Format.pp_print_string fmt "catala_unit(v=0)"
| LUnit -> Format.pp_print_string fmt "new(\"catala_unit\",v=0)"
| LRat i ->
Format.fprintf fmt "catala_decimal_from_string(\"%a\")" Print.lit (LRat i)
Format.fprintf fmt "catala_decimal_from_fraction(%s,%s)"
(if Z.fits_nativeint (Q.num i) then Z.to_string (Q.num i)
else "\"" ^ Z.to_string (Q.num i) ^ "\"")
(if Z.fits_nativeint (Q.den i) then Z.to_string (Q.den i)
else "\"" ^ Z.to_string (Q.den i) ^ "\"")
| LMoney e ->
Format.fprintf fmt "catala_money_from_cents(\"%s\")"
(Runtime.integer_to_string (Runtime.money_to_cents e))
if Z.fits_nativeint e then
Format.fprintf fmt "catala_money_from_cents(%s)"
(Runtime.integer_to_string (Runtime.money_to_cents e))
else
Format.fprintf fmt "catala_money_from_cents(\"%s\")"
(Runtime.integer_to_string (Runtime.money_to_cents e))
| LDate d ->
Format.fprintf fmt "catala_date_from_ymd(%d,%d,%d)"
(Runtime.integer_to_int (Runtime.year_of_date d))

10
runtimes/r/NAMESPACE
View File

@ -2,33 +2,29 @@
export(catala_assertion_failure)
export(catala_conflict_error)
export(catala_date)
export(catala_date_first_day_of_month)
export(catala_date_from_ymd)
export(catala_date_last_day_of_month)
export(catala_date_to_string)
export(catala_day_of_month_of_date)
export(catala_decimal)
export(catala_decimal_from_fraction)
export(catala_decimal_from_integer)
export(catala_decimal_from_money)
export(catala_decimal_from_numeric)
export(catala_decimal_from_string)
export(catala_decimal_round)
export(catala_decimal_to_numeric)
export(catala_duration)
export(catala_duration_from_ymd)
export(catala_duration_to_ymd)
export(catala_empty_error)
export(catala_handle_default)
export(catala_integer)
export(catala_integer_from_numeric)
export(catala_integer_from_string)
export(catala_integer_to_numeric)
export(catala_list_filter)
export(catala_list_fold_left)
export(catala_list_length)
export(catala_list_map)
export(catala_list_reduce)
export(catala_money)
export(catala_money_from_cents)
export(catala_money_from_decimal)
export(catala_money_from_units)
@ -37,9 +33,7 @@ export(catala_money_to_numeric)
export(catala_money_to_string)
export(catala_month_number_of_date)
export(catala_no_value_provided_error)
export(catala_position)
export(catala_position_to_string)
export(catala_unit)
export(catala_year_of_date)
export(dead_value)
exportClasses(catala_date)

86
runtimes/r/R/runtime.R
View File

@ -7,7 +7,7 @@
#' @export
setClass(
"catala_integer",
representation(v = "bigz"),
representation(v = "bigz")
)
#' @export
setMethod("Arith", "catala_integer", function(e1, e2) {
@ -16,7 +16,7 @@ setMethod("Arith", "catala_integer", function(e1, e2) {
})
#' @export
setMethod("-", c("catala_integer", "missing"), function(e1) {
catala_integer(v = -e1@v)
new("catala_integer", v = -e1@v)
})
#' @export
setMethod("Compare", "catala_integer", function(e1, e2) {
@ -28,7 +28,7 @@ setMethod("Compare", "catala_integer", function(e1, e2) {
#' @export
setClass(
"catala_decimal",
representation(v = "bigq"),
representation(v = "bigq")
)
#' @export
setMethod("Arith", "catala_decimal", function(e1, e2) {
@ -37,7 +37,7 @@ setMethod("Arith", "catala_decimal", function(e1, e2) {
})
#' @export
setMethod("-", c("catala_decimal", "missing"), function(e1) {
catala_decimal(v = -e1@v)
new("catala_decimal", v = -e1@v)
})
#' @export
setMethod("Compare", "catala_decimal", function(e1, e2) {
@ -49,27 +49,27 @@ setMethod("Compare", "catala_decimal", function(e1, e2) {
#' @export
setClass(
"catala_money",
representation(v = "bigz"),
representation(v = "bigz")
)
#' @export
setMethod("+", c("catala_money", "catala_money"), function(e1, e2) {
catala_money(v = e1@v + e2@v)
new("catala_money", v = e1@v + e2@v)
})
#' @export
setMethod("-", c("catala_money", "catala_money"), function(e1, e2) {
catala_money(v = e1@v - e2@v)
new("catala_money", v = e1@v - e2@v)
})
#' @export
setMethod("-", c("catala_money", "missing"), function(e1) {
catala_money(v = -e1@v)
new("catala_money", v = -e1@v)
})
#' @export
setMethod("*", c("catala_money", "catala_decimal"), function(e1, e2) {
catala_money(v = as.bigz(as.bigq(e1@v) * e2@v))
new("catala_money", v = as.bigz(as.bigq(e1@v) * e2@v))
})
#' @export
setMethod("/", c("catala_money", "catala_money"), function(e1, e2) {
catala_decimal(v = as.bigq(e1@v / e2@v))
new("catala_decimal", v = as.bigq(e1@v / e2@v))
})
#' @export
setMethod("Compare", "catala_money", function(e1, e2) {
@ -79,25 +79,25 @@ setMethod("Compare", "catala_money", function(e1, e2) {
################ Duration #################
#' @export
suppressWarnings(setClass(
setClass(
"catala_duration",
representation(v = "Period")
))
)
#' @export
setMethod("+", c("catala_duration", "catala_duration"), function(e1, e2) {
catala_duration(v = e1@v + e2@v)
new("catala_duration", v = e1@v + e2@v)
})
#' @export
setMethod("-", c("catala_duration", "catala_duration"), function(e1, e2) {
catala_duration(v = e1@v - e2@v)
new("catala_duration", v = e1@v - e2@v)
})
#' @export
setMethod("-", c("catala_duration", "missing"), function(e1) {
catala_duration(v = -e1@v)
new("catala_duration", v = -e1@v)
})
#' @export
setMethod("/", c("catala_duration", "catala_duration"), function(e1, e2) {
catala_duration(v = e1@v / e2@v)
new("catala_duration", v = e1@v / e2@v)
})
#' @export
setMethod("Compare", "catala_duration", function(e1, e2) {
@ -113,15 +113,15 @@ setMethod("Compare", "catala_duration", function(e1, e2) {
#' @export
setClass(
"catala_date",
representation(v = "Date"),
representation(v = "Date")
)
#' @export
setMethod("+", c("catala_date", "catala_duration"), function(e1, e2) {
catala_date(v = e1@v + e2@v)
new("catala_date", v = e1@v + e2@v)
})
#' @export
setMethod("-", c("catala_date", "catala_date"), function(e1, e2) {
catala_date(v = e1@v - e2@v)
new("catala_date", v = e1@v - e2@v)
})
#' @export
setMethod("Compare", "catala_date", function(e1, e2) {
@ -131,7 +131,7 @@ setMethod("Compare", "catala_date", function(e1, e2) {
################ Unit #################
#' @export
catala_unit <- setClass("catala_unit", representation(v = "numeric"))
setClass("catala_unit", representation(v = "numeric"))
################ Constructors and conversions #################
@ -139,11 +139,11 @@ catala_unit <- setClass("catala_unit", representation(v = "numeric"))
#' @export
catala_money_from_units <- function(x) {
catala_money(v = as.bigz(x) * as.bigz(100))
new("catala_money", v = as.bigz(x) * as.bigz(100))
}
#' @export
catala_money_from_cents <- function(x) {
catala_money(v = as.bigz(x))
new("catala_money", v = as.bigz(x))
}
#' @export
catala_money_from_decimal <- function(d) {
@ -151,9 +151,9 @@ catala_money_from_decimal <- function(d) {
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)
new("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)))
new("catala_money", v = as.bigz(sign(d@v)) * (unit_part_num_cents_z + as.bigz(1)))
}
}
#' @export
@ -169,9 +169,9 @@ 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))
new("catala_money", v = sign(m@v) * q * as.bigz(100))
} else {
catala_money(v = sign(m@v) * (q + 1) * as.bigz(100))
new("catala_money", v = sign(m@v) * (q + 1) * as.bigz(100))
}
}
@ -180,15 +180,15 @@ catala_money_round <- function(m) {
#' @export
catala_decimal_from_numeric <- function(x) {
catala_decimal(v = as.bigq(x))
new("catala_decimal", v = as.bigq(x))
}
#' @export
catala_decimal_from_string <- function(x) {
catala_decimal(v = as.bigq(x))
catala_decimal_from_fraction <- function(x, y) {
new("catala_decimal", v = as.bigq(n = x, d = y))
}
#' @export
catala_decimal_from_integer <- function(x) {
catala_decimal(v = as.bigq(x@v))
new("catala_decimal", v = as.bigq(x@v))
}
#' @export
catala_decimal_to_numeric <- function(x) {
@ -199,25 +199,25 @@ 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)
new("catala_decimal", v = sign(d@v) * q)
} else {
catala_decimal(v = sign(d@v) * (q + as.bigq(1)))
new("catala_decimal", v = sign(d@v) * (q + as.bigq(1)))
}
}
#' @export
catala_decimal_from_money <- function(m) {
catala_decimal(v = as.bigq(as.bigq(m@v) / as.bigq(100)))
new("catala_decimal", v = as.bigq(as.bigq(m@v) / as.bigq(100)))
}
# Integers
#' @export
catala_integer_from_numeric <- function(x) {
catala_integer(v = as.bigz(x))
new("catala_integer", v = as.bigz(x))
}
#' @export
catala_integer_from_string <- function(x) {
catala_integer(v = as.bigz(x))
new("catala_integer", v = as.bigz(x))
}
#' @export
catala_integer_to_numeric <- function(x) {
@ -228,7 +228,7 @@ catala_integer_to_numeric <- function(x) {
#' @export
catala_date_from_ymd <- function(y, m, d) {
catala_date(v = make_date(year = y, month = m, day = d))
new("catala_date", v = make_date(year = y, month = m, day = d))
}
#' @export
catala_day_of_month_of_date <- function(d) {
@ -248,11 +248,11 @@ catala_date_to_string <- function(d) {
}
#' @export
catala_date_first_day_of_month <- function(d) {
catala_date(v = make_date(year = year(d@v), month = month(d@v), day = 1))
new("catala_date", v = make_date(year = year(d@v), month = month(d@v), day = 1))
}
#' @export
catala_date_last_day_of_month <- function(d) {
catala_date(v = make_date(
new("catala_date", v = make_date(
year = year(d@v),
month = month(d@v),
day = days_in_month(d@v)
@ -263,7 +263,7 @@ catala_date_last_day_of_month <- function(d) {
#' @export
catala_duration_from_ymd <- function(y, m, d) {
catala_duration(v = years(y) + months(m) + days(d))
new("catala_duration", v = years(y) + months(m) + days(d))
}
#' @export
catala_duration_to_ymd <- function(d) {
@ -272,6 +272,7 @@ catala_duration_to_ymd <- function(d) {
# List
#' @export
catala_list_fold_left <- function(f, init, l) {
Reduce(f, l, init)
}
@ -362,7 +363,7 @@ catala_assertion_failure <- function(pos) {
catala_handle_default <- function(pos, exceptions, just, cons) {
acc <- Reduce(function(acc, exception) {
new_val <- tryCatch(
exception(catala_unit(v = 0)),
exception(new("catala_unit", v = 0)),
catala_empty_error = function(e) {
NULL
}
@ -378,8 +379,8 @@ catala_handle_default <- function(pos, exceptions, just, cons) {
}
}, exceptions, NULL)
if (is.null(acc)) {
if (just(catala_unit(v = 0))) {
cons(catala_unit(v = 0))
if (just(new("catala_unit", v = 0))) {
cons(new("catala_unit", v = 0))
} else {
stop(catala_empty_error())
}
@ -392,5 +393,6 @@ catala_handle_default <- function(pos, exceptions, just, cons) {
# it to accept dead code. Indeed, when raising an exception during a variable
# definition, R could complains that the later dead code will not know what
# this variable was. So we give this variable a dead value.
#' @export
dead_value <- 0