Skip to content

Some small optims #925

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
AltGr merged 2 commits into from
Dec 18, 2025
Merged

Some small optims #925

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
9ee51ac
small string comparison optim
AltGr Dec 16, 2025
5a1d320
Small improvement on equality expansion
AltGr Dec 16, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
72 changes: 44 additions & 28 deletions compiler/catala_utils/string.ml
View file
Open in desktop
Copy link
Contributor

@denismerigoux denismerigoux Dec 17, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Do you have a sense of how much speed gain we get thanks to that?

Copy link
Contributor Author

@AltGr AltGr Dec 18, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

For expand_op, we should gain a lot in code size (and thus compilation / interpretation time): the code generated is now linear in size instead of quadratic in the number of constructors, when considering only the constant constructors. That could be life-saving for the cases that caused problem with OCaml's 244 constructors limitation.

For the string comparison, Vincent reported performance issues on sets and it should alleviate them, but I haven't benched yet (from reading the code, the missing fast-path was the main difference between our function and the OCaml built-in comparison ; but the latter is also based on memcmp which we can't compete with)

Original file line number Diff line number Diff line change
Expand Up @@ -133,34 +133,50 @@ module Arg = struct
let format = format

let compare s1 s2 =
let len1 = length s1 in
let len2 = length s2 in
let int c = int_of_char c - int_of_char '0' in
let rec readnum acc s i =
if i >= length s then acc, i
else
match get s i with
| '0' .. '9' as c -> readnum ((acc * 10) + int c) s (i + 1)
| _ -> acc, i
in
let rec aux i1 i2 =
if i1 >= len1 then if i2 >= len2 then 0 else -1
else if i2 >= len2 then 1
else
match get s1 i1, get s2 i2 with
| ('0' .. '9' as c1), ('0' .. '9' as c2) -> (
let x1, i1' = readnum (int c1) s1 (i1 + 1) in
let x2, i2' = readnum (int c2) s2 (i2 + 1) in
match Int.compare x1 x2 with
| 0 -> (
match Int.compare (i1' - i1) (i2' - i2) with
| 0 -> aux i1' i2'
| n -> n)
| n -> n)
| c1, c2 -> (
match Char.compare c1 c2 with 0 -> aux (i1 + 1) (i2 + 1) | n -> n)
in
aux 0 0
if s1 == s2 then 0
else
let len1 = length s1 in
let len2 = length s2 in
let int c = int_of_char c - int_of_char '0' in
let rec readnum acc s i =
if i >= length s then acc, i
else
match get s i with
| '0' .. '9' as c -> readnum ((acc * 10) + int c) s (i + 1)
| _ -> acc, i
in
let rec aux i1 i2 =
if i1 >= len1 then if i2 >= len2 then 0 else -1
else if i2 >= len2 then 1
else
let c1 = get s1 i1 and c2 = get s2 i2 in
if Char.equal c1 c2 then aux (i1 + 1) (i2 + 1)
else
match c1, c2 with
| '0' .. '9', _ -> (
let x1, i1' = readnum (int c1) s1 (i1 + 1) in
let x2, i2' = readnum 0 s2 i2 in
match Int.compare x1 x2 with
| 0 -> (
match Int.compare (i1' - i1) (i2' - i2) with
| 0 -> aux i1' i2'
| n -> n)
| n -> n)
| _, '0' .. '9' -> (
let x1, i1' = readnum 0 s1 i1 in
let x2, i2' = readnum (int c2) s2 (i2 + 1) in
match Int.compare x1 x2 with
| 0 -> (
match Int.compare (i1' - i1) (i2' - i2) with
| 0 -> aux i1' i2'
| n -> n)
| n -> n)
| _ -> (
match Char.compare c1 c2 with
| 0 -> aux (i1 + 1) (i2 + 1)
| n -> n)
in
aux 0 0
end

let compare = Arg.compare
Expand Down
69 changes: 42 additions & 27 deletions compiler/lcalc/expand_op.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -75,34 +75,49 @@ let rec resolve_eq ctx pos ty args m =
match args with [arg1; arg2] -> arg1, arg2 | _ -> assert false
in
let constrs = EnumName.Map.find name ctx.ctx_enums in
let cases =
EnumConstructor.Map.mapi
(fun cstr ty ->
let v1 = Var.make "v1" in
let cases =
EnumConstructor.Map.mapi
(fun cstr2 ty ->
if EnumConstructor.equal cstr cstr2 then
let v2 = Var.make "v2" in
Expr.make_ghost_abs [v2]
(resolve_eq ctx pos ty
[
Expr.evar v1 (Expr.with_ty m ty);
Expr.evar v2 (Expr.with_ty m ty);
]
m)
[ty] pos
else
Expr.make_ghost_abs
[Var.make "_"]
(Expr.elit (LBool false) m)
[ty] pos)
constrs
in
Expr.make_ghost_abs [v1] (Expr.ematch ~name ~e:arg2 ~cases m) [ty] pos)
if
EnumConstructor.Map.for_all
(fun _ -> function TLit TUnit, _ -> true | _ -> false)
constrs
in
Expr.ematch ~name ~e:arg1 ~cases m
then Expr.eappop ~op:(Eq, pos) ~args ~tys:[ty; ty] m
else
let cases =
EnumConstructor.Map.mapi
(fun cstr ty1 ->
match ty1 with
| TLit TUnit, _ ->
Expr.make_ghost_abs
[Var.make "_"]
(Expr.eappop ~op:(Eq, pos) ~args ~tys:[ty; ty] m)
[ty1] pos
| _ ->
let v1 = Var.make "v1" in
let cases =
EnumConstructor.Map.mapi
(fun cstr2 ty2 ->
if EnumConstructor.equal cstr cstr2 then
let v2 = Var.make "v2" in
Expr.make_ghost_abs [v2]
(resolve_eq ctx pos ty1
[
Expr.evar v1 (Expr.with_ty m ty1);
Expr.evar v2 (Expr.with_ty m ty1);
]
m)
[ty1] pos
else
Expr.make_ghost_abs
[Var.make "_"]
(Expr.elit (LBool false) m)
[ty2] pos)
constrs
in
Expr.make_ghost_abs [v1]
(Expr.ematch ~name ~e:arg2 ~cases m)
[ty1] pos)
constrs
in
Expr.ematch ~name ~e:arg1 ~cases m
| TArray ty1 ->
let tbool = TLit TBool, pos in
let vargs =
Expand Down
5 changes: 5 additions & 0 deletions compiler/scalc/to_c.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -347,6 +347,11 @@ let rec format_expression
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
format_expression)
args
| EAppOp { op = Eq, _; args = [x1; x2]; _ } ->
(* The Eq operator must have been expanded: this should only concern
constant constructor equality checks *)
Format.fprintf fmt "catala_new_bool(@[<hov 0>(%a)->code == (%a)->code)@]"
format_expression x1 format_expression x2
| EAppOp { op = ((And | Or) as op), _; args; _ } ->
Format.fprintf fmt "catala_new_bool(@[<hov 0>%a)@]"
(Format.pp_print_list
Expand Down