CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-09 22:16:10 +03:00
Code Issues Projects Releases Wiki Activity
c94509e0bb
catala/compiler/shared_ast/operator.ml

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

552 lines
19 KiB
OCaml
Raw Normal View History

Add overloaded operators for the common operations This uses the same disambiguation mechanism put in place for structures, calling the typer on individual rules on the desugared AST to propagate types, in order to resolve ambiguous operators like `+` to their strongly typed counterparts (`+!`, `+.`, `+$`, `+@`, `+$`) in the translation to scopelang. The patch includes some normalisation of the definition of all the operators, and classifies them based on their typing policy instead of their arity. It also adds a little more flexibility: - a couple new operators, like `-` on date and duration - optional type annotation on some aggregation constructions The `Shared_ast` lib is also lightly restructured, with the `Expr` module split into `Type`, `Operator` and `Expr`.
2022-11-29 11:47:53 +03:00
(* This file is part of the Catala compiler, a specification language for tax
and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
Louis Gesbert <louis.gesbert@inria.fr>
Licensed under the Apache License, Version 2.0 (the "License"); you may not
use this file except in compliance with the License. You may obtain a copy of
the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
License for the specific language governing permissions and limitations under
the License. *)
open Catala_utils
open Definitions
include Definitions.Op
let name : type a k. (a, k) t -> string = function
| Not -> "o_not"
| Length -> "o_length"
| IntToRat -> "o_intToRat"
| MoneyToRat -> "o_moneyToRat"
| RatToMoney -> "o_ratToMoney"
| GetDay -> "o_getDay"
| GetMonth -> "o_getMonth"
| GetYear -> "o_getYear"
| FirstDayOfMonth -> "o_firstDayOfMonth"
| LastDayOfMonth -> "o_lastDayOfMonth"
| RoundMoney -> "o_roundMoney"
| RoundDecimal -> "o_roundDecimal"
| Log _ -> "o_log"
| Minus -> "o_minus"
| Minus_int -> "o_minus_int"
| Minus_rat -> "o_minus_rat"
| Minus_mon -> "o_minus_mon"
| Minus_dur -> "o_minus_dur"
| And -> "o_and"
| Or -> "o_or"
| Xor -> "o_xor"
| Eq -> "o_eq"
| Map -> "o_map"
| Concat -> "o_concat"
| Filter -> "o_filter"
New syntax for collection operations
2022-12-12 18:02:07 +03:00
| Reduce -> "o_reduce"
Add overloaded operators for the common operations This uses the same disambiguation mechanism put in place for structures, calling the typer on individual rules on the desugared AST to propagate types, in order to resolve ambiguous operators like `+` to their strongly typed counterparts (`+!`, `+.`, `+$`, `+@`, `+$`) in the translation to scopelang. The patch includes some normalisation of the definition of all the operators, and classifies them based on their typing policy instead of their arity. It also adds a little more flexibility: - a couple new operators, like `-` on date and duration - optional type annotation on some aggregation constructions The `Shared_ast` lib is also lightly restructured, with the `Expr` module split into `Type`, `Operator` and `Expr`.
2022-11-29 11:47:53 +03:00
| Add -> "o_add"
| Add_int_int -> "o_add_int_int"
| Add_rat_rat -> "o_add_rat_rat"
| Add_mon_mon -> "o_add_mon_mon"
| Add_dat_dur -> "o_add_dat_dur"
| Add_dur_dur -> "o_add_dur_dur"
| Sub -> "o_sub"
| Sub_int_int -> "o_sub_int_int"
| Sub_rat_rat -> "o_sub_rat_rat"
| Sub_mon_mon -> "o_sub_mon_mon"
| Sub_dat_dat -> "o_sub_dat_dat"
| Sub_dat_dur -> "o_sub_dat_dur"
| Sub_dur_dur -> "o_sub_dur_dur"
| Mult -> "o_mult"
| Mult_int_int -> "o_mult_int_int"
| Mult_rat_rat -> "o_mult_rat_rat"
| Mult_mon_rat -> "o_mult_mon_rat"
| Mult_dur_int -> "o_mult_dur_int"
| Div -> "o_div"
| Div_int_int -> "o_div_int_int"
| Div_rat_rat -> "o_div_rat_rat"
| Div_mon_mon -> "o_div_mon_mon"
| Div_mon_rat -> "o_div_mon_mon"
| Lt -> "o_lt"
| Lt_int_int -> "o_lt_int_int"
| Lt_rat_rat -> "o_lt_rat_rat"
| Lt_mon_mon -> "o_lt_mon_mon"
| Lt_dur_dur -> "o_lt_dur_dur"
| Lt_dat_dat -> "o_lt_dat_dat"
| Lte -> "o_lte"
| Lte_int_int -> "o_lte_int_int"
| Lte_rat_rat -> "o_lte_rat_rat"
| Lte_mon_mon -> "o_lte_mon_mon"
| Lte_dur_dur -> "o_lte_dur_dur"
| Lte_dat_dat -> "o_lte_dat_dat"
| Gt -> "o_gt"
| Gt_int_int -> "o_gt_int_int"
| Gt_rat_rat -> "o_gt_rat_rat"
| Gt_mon_mon -> "o_gt_mon_mon"
| Gt_dur_dur -> "o_gt_dur_dur"
| Gt_dat_dat -> "o_gt_dat_dat"
| Gte -> "o_gte"
| Gte_int_int -> "o_gte_int_int"
| Gte_rat_rat -> "o_gte_rat_rat"
| Gte_mon_mon -> "o_gte_mon_mon"
| Gte_dur_dur -> "o_gte_dur_dur"
| Gte_dat_dat -> "o_gte_dat_dat"
| Eq_int_int -> "o_eq_int_int"
| Eq_rat_rat -> "o_eq_rat_rat"
| Eq_mon_mon -> "o_eq_mon_mon"
| Eq_dur_dur -> "o_eq_dur_dur"
| Eq_dat_dat -> "o_eq_dat_dat"
| Fold -> "o_fold"
let compare_log_entries l1 l2 =
match l1, l2 with
| VarDef t1, VarDef t2 -> Type.compare (t1, Pos.no_pos) (t2, Pos.no_pos)
| BeginCall, BeginCall
| EndCall, EndCall
| PosRecordIfTrueBool, PosRecordIfTrueBool ->
0
| VarDef _, _ -> -1
| _, VarDef _ -> 1
| BeginCall, _ -> -1
| _, BeginCall -> 1
| EndCall, _ -> -1
| _, EndCall -> 1
| PosRecordIfTrueBool, _ -> .
| _, PosRecordIfTrueBool -> .
let compare (type a k a2 k2) (t1 : (a, k) t) (t2 : (a2, k2) t) =
match[@ocamlformat "disable"] t1, t2 with
| Log (l1, info1), Log (l2, info2) -> (
match compare_log_entries l1 l2 with
| 0 -> List.compare Uid.MarkedString.compare info1 info2
| n -> n)
| Not, Not
| Length, Length
| IntToRat, IntToRat
| MoneyToRat, MoneyToRat
| RatToMoney, RatToMoney
| GetDay, GetDay
| GetMonth, GetMonth
| GetYear, GetYear
| FirstDayOfMonth, FirstDayOfMonth
| LastDayOfMonth, LastDayOfMonth
| RoundMoney, RoundMoney
| RoundDecimal, RoundDecimal
| Minus, Minus
| Minus_int, Minus_int
| Minus_rat, Minus_rat
| Minus_mon, Minus_mon
| Minus_dur, Minus_dur
| And, And
| Or, Or
| Xor, Xor
| Eq, Eq
| Map, Map
| Concat, Concat
| Filter, Filter
New syntax for collection operations
2022-12-12 18:02:07 +03:00
| Reduce, Reduce
Add overloaded operators for the common operations This uses the same disambiguation mechanism put in place for structures, calling the typer on individual rules on the desugared AST to propagate types, in order to resolve ambiguous operators like `+` to their strongly typed counterparts (`+!`, `+.`, `+$`, `+@`, `+$`) in the translation to scopelang. The patch includes some normalisation of the definition of all the operators, and classifies them based on their typing policy instead of their arity. It also adds a little more flexibility: - a couple new operators, like `-` on date and duration - optional type annotation on some aggregation constructions The `Shared_ast` lib is also lightly restructured, with the `Expr` module split into `Type`, `Operator` and `Expr`.
2022-11-29 11:47:53 +03:00
| Add, Add
| Add_int_int, Add_int_int
| Add_rat_rat, Add_rat_rat
| Add_mon_mon, Add_mon_mon
| Add_dat_dur, Add_dat_dur
| Add_dur_dur, Add_dur_dur
| Sub, Sub
| Sub_int_int, Sub_int_int
| Sub_rat_rat, Sub_rat_rat
| Sub_mon_mon, Sub_mon_mon
| Sub_dat_dat, Sub_dat_dat
| Sub_dat_dur, Sub_dat_dur
| Sub_dur_dur, Sub_dur_dur
| Mult, Mult
| Mult_int_int, Mult_int_int
| Mult_rat_rat, Mult_rat_rat
| Mult_mon_rat, Mult_mon_rat
| Mult_dur_int, Mult_dur_int
| Div, Div
| Div_int_int, Div_int_int
| Div_rat_rat, Div_rat_rat
| Div_mon_mon, Div_mon_mon
| Div_mon_rat, Div_mon_rat
| Lt, Lt
| Lt_int_int, Lt_int_int
| Lt_rat_rat, Lt_rat_rat
| Lt_mon_mon, Lt_mon_mon
| Lt_dat_dat, Lt_dat_dat
| Lt_dur_dur, Lt_dur_dur
| Lte, Lte
| Lte_int_int, Lte_int_int
| Lte_rat_rat, Lte_rat_rat
| Lte_mon_mon, Lte_mon_mon
| Lte_dat_dat, Lte_dat_dat
| Lte_dur_dur, Lte_dur_dur
| Gt, Gt
| Gt_int_int, Gt_int_int
| Gt_rat_rat, Gt_rat_rat
| Gt_mon_mon, Gt_mon_mon
| Gt_dat_dat, Gt_dat_dat
| Gt_dur_dur, Gt_dur_dur
| Gte, Gte
| Gte_int_int, Gte_int_int
| Gte_rat_rat, Gte_rat_rat
| Gte_mon_mon, Gte_mon_mon
| Gte_dat_dat, Gte_dat_dat
| Gte_dur_dur, Gte_dur_dur
| Eq_int_int, Eq_int_int
| Eq_rat_rat, Eq_rat_rat
| Eq_mon_mon, Eq_mon_mon
| Eq_dat_dat, Eq_dat_dat
| Eq_dur_dur, Eq_dur_dur
| Fold, Fold -> 0
| Not, _ -> -1 | _, Not -> 1
| Length, _ -> -1 | _, Length -> 1
| IntToRat, _ -> -1 | _, IntToRat -> 1
| MoneyToRat, _ -> -1 | _, MoneyToRat -> 1
| RatToMoney, _ -> -1 | _, RatToMoney -> 1
| GetDay, _ -> -1 | _, GetDay -> 1
| GetMonth, _ -> -1 | _, GetMonth -> 1
| GetYear, _ -> -1 | _, GetYear -> 1
| FirstDayOfMonth, _ -> -1 | _, FirstDayOfMonth -> 1
| LastDayOfMonth, _ -> -1 | _, LastDayOfMonth -> 1
| RoundMoney, _ -> -1 | _, RoundMoney -> 1
| RoundDecimal, _ -> -1 | _, RoundDecimal -> 1
| Log _, _ -> -1 | _, Log _ -> 1
| Minus, _ -> -1 | _, Minus -> 1
| Minus_int, _ -> -1 | _, Minus_int -> 1
| Minus_rat, _ -> -1 | _, Minus_rat -> 1
| Minus_mon, _ -> -1 | _, Minus_mon -> 1
| Minus_dur, _ -> -1 | _, Minus_dur -> 1
| And, _ -> -1 | _, And -> 1
| Or, _ -> -1 | _, Or -> 1
| Xor, _ -> -1 | _, Xor -> 1
| Eq, _ -> -1 | _, Eq -> 1
| Map, _ -> -1 | _, Map -> 1
| Concat, _ -> -1 | _, Concat -> 1
| Filter, _ -> -1 | _, Filter -> 1
New syntax for collection operations
2022-12-12 18:02:07 +03:00
| Reduce, _ -> -1 | _, Reduce -> 1
Add overloaded operators for the common operations This uses the same disambiguation mechanism put in place for structures, calling the typer on individual rules on the desugared AST to propagate types, in order to resolve ambiguous operators like `+` to their strongly typed counterparts (`+!`, `+.`, `+$`, `+@`, `+$`) in the translation to scopelang. The patch includes some normalisation of the definition of all the operators, and classifies them based on their typing policy instead of their arity. It also adds a little more flexibility: - a couple new operators, like `-` on date and duration - optional type annotation on some aggregation constructions The `Shared_ast` lib is also lightly restructured, with the `Expr` module split into `Type`, `Operator` and `Expr`.
2022-11-29 11:47:53 +03:00
| Add, _ -> -1 | _, Add -> 1
| Add_int_int, _ -> -1 | _, Add_int_int -> 1
| Add_rat_rat, _ -> -1 | _, Add_rat_rat -> 1
| Add_mon_mon, _ -> -1 | _, Add_mon_mon -> 1
| Add_dat_dur, _ -> -1 | _, Add_dat_dur -> 1
| Add_dur_dur, _ -> -1 | _, Add_dur_dur -> 1
| Sub, _ -> -1 | _, Sub -> 1
| Sub_int_int, _ -> -1 | _, Sub_int_int -> 1
| Sub_rat_rat, _ -> -1 | _, Sub_rat_rat -> 1
| Sub_mon_mon, _ -> -1 | _, Sub_mon_mon -> 1
| Sub_dat_dat, _ -> -1 | _, Sub_dat_dat -> 1
| Sub_dat_dur, _ -> -1 | _, Sub_dat_dur -> 1
| Sub_dur_dur, _ -> -1 | _, Sub_dur_dur -> 1
| Mult, _ -> -1 | _, Mult -> 1
| Mult_int_int, _ -> -1 | _, Mult_int_int -> 1
| Mult_rat_rat, _ -> -1 | _, Mult_rat_rat -> 1
| Mult_mon_rat, _ -> -1 | _, Mult_mon_rat -> 1
| Mult_dur_int, _ -> -1 | _, Mult_dur_int -> 1
| Div, _ -> -1 | _, Div -> 1
| Div_int_int, _ -> -1 | _, Div_int_int -> 1
| Div_rat_rat, _ -> -1 | _, Div_rat_rat -> 1
| Div_mon_mon, _ -> -1 | _, Div_mon_mon -> 1
| Div_mon_rat, _ -> -1 | _, Div_mon_rat -> 1
| Lt, _ -> -1 | _, Lt -> 1
| Lt_int_int, _ -> -1 | _, Lt_int_int -> 1
| Lt_rat_rat, _ -> -1 | _, Lt_rat_rat -> 1
| Lt_mon_mon, _ -> -1 | _, Lt_mon_mon -> 1
| Lt_dat_dat, _ -> -1 | _, Lt_dat_dat -> 1
| Lt_dur_dur, _ -> -1 | _, Lt_dur_dur -> 1
| Lte, _ -> -1 | _, Lte -> 1
| Lte_int_int, _ -> -1 | _, Lte_int_int -> 1
| Lte_rat_rat, _ -> -1 | _, Lte_rat_rat -> 1
| Lte_mon_mon, _ -> -1 | _, Lte_mon_mon -> 1
| Lte_dat_dat, _ -> -1 | _, Lte_dat_dat -> 1
| Lte_dur_dur, _ -> -1 | _, Lte_dur_dur -> 1
| Gt, _ -> -1 | _, Gt -> 1
| Gt_int_int, _ -> -1 | _, Gt_int_int -> 1
| Gt_rat_rat, _ -> -1 | _, Gt_rat_rat -> 1
| Gt_mon_mon, _ -> -1 | _, Gt_mon_mon -> 1
| Gt_dat_dat, _ -> -1 | _, Gt_dat_dat -> 1
| Gt_dur_dur, _ -> -1 | _, Gt_dur_dur -> 1
| Gte, _ -> -1 | _, Gte -> 1
| Gte_int_int, _ -> -1 | _, Gte_int_int -> 1
| Gte_rat_rat, _ -> -1 | _, Gte_rat_rat -> 1
| Gte_mon_mon, _ -> -1 | _, Gte_mon_mon -> 1
| Gte_dat_dat, _ -> -1 | _, Gte_dat_dat -> 1
| Gte_dur_dur, _ -> -1 | _, Gte_dur_dur -> 1
| Eq_int_int, _ -> -1 | _, Eq_int_int -> 1
| Eq_rat_rat, _ -> -1 | _, Eq_rat_rat -> 1
| Eq_mon_mon, _ -> -1 | _, Eq_mon_mon -> 1
| Eq_dat_dat, _ -> -1 | _, Eq_dat_dat -> 1
| Eq_dur_dur, _ -> -1 | _, Eq_dur_dur -> 1
| Fold, _ | _, Fold -> .
let equal (type a k a2 k2) (t1 : (a, k) t) (t2 : (a2, k2) t) = compare t1 t2 = 0
(* Classification of operators *)
let kind_dispatch :
type a b k.
polymorphic:((_, polymorphic) t -> b) ->
monomorphic:((_, monomorphic) t -> b) ->
?overloaded:((_, overloaded) t -> b) ->
?resolved:((_, resolved) t -> b) ->
(a, k) t ->
b =
fun ~polymorphic ~monomorphic ?(overloaded = fun _ -> assert false)
?(resolved = fun _ -> assert false) op ->
match op with
| ( Not | IntToRat | MoneyToRat | RatToMoney | GetDay | GetMonth | GetYear
| FirstDayOfMonth | LastDayOfMonth | RoundMoney | RoundDecimal | And | Or
| Xor ) as op ->
monomorphic op
New syntax for collection operations
2022-12-12 18:02:07 +03:00
| (Log _ | Length | Eq | Map | Concat | Filter | Reduce | Fold) as op ->
polymorphic op
Add overloaded operators for the common operations This uses the same disambiguation mechanism put in place for structures, calling the typer on individual rules on the desugared AST to propagate types, in order to resolve ambiguous operators like `+` to their strongly typed counterparts (`+!`, `+.`, `+$`, `+@`, `+$`) in the translation to scopelang. The patch includes some normalisation of the definition of all the operators, and classifies them based on their typing policy instead of their arity. It also adds a little more flexibility: - a couple new operators, like `-` on date and duration - optional type annotation on some aggregation constructions The `Shared_ast` lib is also lightly restructured, with the `Expr` module split into `Type`, `Operator` and `Expr`.
2022-11-29 11:47:53 +03:00
| (Minus | Add | Sub | Mult | Div | Lt | Lte | Gt | Gte) as op ->
overloaded op
| ( Minus_int | Minus_rat | Minus_mon | Minus_dur | Add_int_int | Add_rat_rat
| Add_mon_mon | Add_dat_dur | Add_dur_dur | Sub_int_int | Sub_rat_rat
| Sub_mon_mon | Sub_dat_dat | Sub_dat_dur | Sub_dur_dur | Mult_int_int
| Mult_rat_rat | Mult_mon_rat | Mult_dur_int | Div_int_int | Div_rat_rat
| Div_mon_mon | Div_mon_rat | Lt_int_int | Lt_rat_rat | Lt_mon_mon
| Lt_dat_dat | Lt_dur_dur | Lte_int_int | Lte_rat_rat | Lte_mon_mon
| Lte_dat_dat | Lte_dur_dur | Gt_int_int | Gt_rat_rat | Gt_mon_mon
| Gt_dat_dat | Gt_dur_dur | Gte_int_int | Gte_rat_rat | Gte_mon_mon
| Gte_dat_dat | Gte_dur_dur | Eq_int_int | Eq_rat_rat | Eq_mon_mon
| Eq_dat_dat | Eq_dur_dur ) as op ->
resolved op
(* Glorified identity... allowed operators are the same in scopelang, dcalc,
lcalc *)
let translate :
type k.
([< scopelang | dcalc | lcalc ], k) t ->
([< scopelang | dcalc | lcalc ], k) t =
fun op ->
match op with
| Length -> Length
| Log (i, l) -> Log (i, l)
| Eq -> Eq
| Map -> Map
| Concat -> Concat
| Filter -> Filter
New syntax for collection operations
2022-12-12 18:02:07 +03:00
| Reduce -> Reduce
Add overloaded operators for the common operations This uses the same disambiguation mechanism put in place for structures, calling the typer on individual rules on the desugared AST to propagate types, in order to resolve ambiguous operators like `+` to their strongly typed counterparts (`+!`, `+.`, `+$`, `+@`, `+$`) in the translation to scopelang. The patch includes some normalisation of the definition of all the operators, and classifies them based on their typing policy instead of their arity. It also adds a little more flexibility: - a couple new operators, like `-` on date and duration - optional type annotation on some aggregation constructions The `Shared_ast` lib is also lightly restructured, with the `Expr` module split into `Type`, `Operator` and `Expr`.
2022-11-29 11:47:53 +03:00
| Fold -> Fold
| Not -> Not
| IntToRat -> IntToRat
| MoneyToRat -> MoneyToRat
| RatToMoney -> RatToMoney
| GetDay -> GetDay
| GetMonth -> GetMonth
| GetYear -> GetYear
| FirstDayOfMonth -> FirstDayOfMonth
| LastDayOfMonth -> LastDayOfMonth
| RoundMoney -> RoundMoney
| RoundDecimal -> RoundDecimal
| And -> And
| Or -> Or
| Xor -> Xor
| Minus_int -> Minus_int
| Minus_rat -> Minus_rat
| Minus_mon -> Minus_mon
| Minus_dur -> Minus_dur
| Add_int_int -> Add_int_int
| Add_rat_rat -> Add_rat_rat
| Add_mon_mon -> Add_mon_mon
| Add_dat_dur -> Add_dat_dur
| Add_dur_dur -> Add_dur_dur
| Sub_int_int -> Sub_int_int
| Sub_rat_rat -> Sub_rat_rat
| Sub_mon_mon -> Sub_mon_mon
| Sub_dat_dat -> Sub_dat_dat
| Sub_dat_dur -> Sub_dat_dur
| Sub_dur_dur -> Sub_dur_dur
| Mult_int_int -> Mult_int_int
| Mult_rat_rat -> Mult_rat_rat
| Mult_mon_rat -> Mult_mon_rat
| Mult_dur_int -> Mult_dur_int
| Div_int_int -> Div_int_int
| Div_rat_rat -> Div_rat_rat
| Div_mon_mon -> Div_mon_mon
| Div_mon_rat -> Div_mon_rat
| Lt_int_int -> Lt_int_int
| Lt_rat_rat -> Lt_rat_rat
| Lt_mon_mon -> Lt_mon_mon
| Lt_dat_dat -> Lt_dat_dat
| Lt_dur_dur -> Lt_dur_dur
| Lte_int_int -> Lte_int_int
| Lte_rat_rat -> Lte_rat_rat
| Lte_mon_mon -> Lte_mon_mon
| Lte_dat_dat -> Lte_dat_dat
| Lte_dur_dur -> Lte_dur_dur
| Gt_int_int -> Gt_int_int
| Gt_rat_rat -> Gt_rat_rat
| Gt_mon_mon -> Gt_mon_mon
| Gt_dat_dat -> Gt_dat_dat
| Gt_dur_dur -> Gt_dur_dur
| Gte_int_int -> Gte_int_int
| Gte_rat_rat -> Gte_rat_rat
| Gte_mon_mon -> Gte_mon_mon
| Gte_dat_dat -> Gte_dat_dat
| Gte_dur_dur -> Gte_dur_dur
| Eq_int_int -> Eq_int_int
| Eq_rat_rat -> Eq_rat_rat
| Eq_mon_mon -> Eq_mon_mon
| Eq_dat_dat -> Eq_dat_dat
| Eq_dur_dur -> Eq_dur_dur
let monomorphic_type (op, pos) =
let ( @- ) a b = TArrow ((TLit a, pos), b), pos in
let ( @-> ) a b = TArrow ((TLit a, pos), (TLit b, pos)), pos in
match op with
| Not -> TBool @-> TBool
| IntToRat -> TInt @-> TRat
| MoneyToRat -> TMoney @-> TRat
| RatToMoney -> TRat @-> TMoney
| GetDay -> TDate @-> TInt
| GetMonth -> TDate @-> TInt
| GetYear -> TDate @-> TInt
| FirstDayOfMonth -> TDate @-> TDate
| LastDayOfMonth -> TDate @-> TDate
| RoundMoney -> TMoney @-> TMoney
| RoundDecimal -> TRat @-> TRat
| And -> TBool @- TBool @-> TBool
| Or -> TBool @- TBool @-> TBool
| Xor -> TBool @- TBool @-> TBool
let resolved_type (op, pos) =
let ( @- ) a b = TArrow ((TLit a, pos), b), pos in
let ( @-> ) a b = TArrow ((TLit a, pos), (TLit b, pos)), pos in
match op with
| Minus_int -> TInt @-> TInt
| Minus_rat -> TRat @-> TRat
| Minus_mon -> TMoney @-> TMoney
| Minus_dur -> TDuration @-> TDuration
| Add_int_int -> TInt @- TInt @-> TInt
| Add_rat_rat -> TRat @- TRat @-> TRat
| Add_mon_mon -> TMoney @- TMoney @-> TMoney
| Add_dat_dur -> TDate @- TDuration @-> TDate
| Add_dur_dur -> TDuration @- TDuration @-> TDuration
| Sub_int_int -> TInt @- TInt @-> TInt
| Sub_rat_rat -> TRat @- TRat @-> TRat
| Sub_mon_mon -> TMoney @- TMoney @-> TMoney
| Sub_dat_dat -> TDate @- TDate @-> TDuration
| Sub_dat_dur -> TDate @- TDuration @-> TDuration
| Sub_dur_dur -> TDuration @- TDuration @-> TDuration
| Mult_int_int -> TInt @- TInt @-> TInt
| Mult_rat_rat -> TRat @- TRat @-> TRat
| Mult_mon_rat -> TMoney @- TRat @-> TMoney
| Mult_dur_int -> TDuration @- TInt @-> TDuration
Remove integer division from the language it's unlikely to be used in any law, and likely to be cause for confusion. best of all, the new operator has a different return type, which ensures no inconsistency with the change can get overlooked.
2022-12-12 19:55:53 +03:00
| Div_int_int -> TInt @- TInt @-> TRat
Add overloaded operators for the common operations This uses the same disambiguation mechanism put in place for structures, calling the typer on individual rules on the desugared AST to propagate types, in order to resolve ambiguous operators like `+` to their strongly typed counterparts (`+!`, `+.`, `+$`, `+@`, `+$`) in the translation to scopelang. The patch includes some normalisation of the definition of all the operators, and classifies them based on their typing policy instead of their arity. It also adds a little more flexibility: - a couple new operators, like `-` on date and duration - optional type annotation on some aggregation constructions The `Shared_ast` lib is also lightly restructured, with the `Expr` module split into `Type`, `Operator` and `Expr`.
2022-11-29 11:47:53 +03:00
| Div_rat_rat -> TRat @- TRat @-> TRat
| Div_mon_mon -> TMoney @- TMoney @-> TRat
| Div_mon_rat -> TMoney @- TRat @-> TMoney
| Lt_int_int -> TInt @- TInt @-> TBool
| Lt_rat_rat -> TRat @- TRat @-> TBool
| Lt_mon_mon -> TMoney @- TMoney @-> TBool
| Lt_dat_dat -> TDate @- TDate @-> TBool
| Lt_dur_dur -> TDuration @- TDuration @-> TBool
| Lte_int_int -> TInt @- TInt @-> TBool
| Lte_rat_rat -> TRat @- TRat @-> TBool
| Lte_mon_mon -> TMoney @- TMoney @-> TBool
| Lte_dat_dat -> TDate @- TDate @-> TBool
| Lte_dur_dur -> TDuration @- TDuration @-> TBool
| Gt_int_int -> TInt @- TInt @-> TBool
| Gt_rat_rat -> TRat @- TRat @-> TBool
| Gt_mon_mon -> TMoney @- TMoney @-> TBool
| Gt_dat_dat -> TDate @- TDate @-> TBool
| Gt_dur_dur -> TDuration @- TDuration @-> TBool
| Gte_int_int -> TInt @- TInt @-> TBool
| Gte_rat_rat -> TRat @- TRat @-> TBool
| Gte_mon_mon -> TMoney @- TMoney @-> TBool
| Gte_dat_dat -> TDate @- TDate @-> TBool
| Gte_dur_dur -> TDuration @- TDuration @-> TBool
| Eq_int_int -> TInt @- TInt @-> TBool
| Eq_rat_rat -> TRat @- TRat @-> TBool
| Eq_mon_mon -> TMoney @- TMoney @-> TBool
| Eq_dat_dat -> TDate @- TDate @-> TBool
| Eq_dur_dur -> TDuration @- TDuration @-> TBool
let resolve_overload_aux (op : ('a, overloaded) t) (operands : typ_lit list) :
('b, resolved) t * [ `Straight | `Reversed ] =
match op, operands with
| Minus, [TInt] -> Minus_int, `Straight
| Minus, [TRat] -> Minus_rat, `Straight
| Minus, [TMoney] -> Minus_mon, `Straight
| Minus, [TDuration] -> Minus_dur, `Straight
| Add, [TInt; TInt] -> Add_int_int, `Straight
| Add, [TRat; TRat] -> Add_rat_rat, `Straight
| Add, [TMoney; TMoney] -> Add_mon_mon, `Straight
| Add, [TDuration; TDuration] -> Add_dur_dur, `Straight
| Add, [TDate; TDuration] -> Add_dat_dur, `Straight
| Add, [TDuration; TDate] -> Add_dat_dur, `Reversed
| Sub, [TInt; TInt] -> Sub_int_int, `Straight
| Sub, [TRat; TRat] -> Sub_rat_rat, `Straight
| Sub, [TMoney; TMoney] -> Sub_mon_mon, `Straight
| Sub, [TDuration; TDuration] -> Sub_dur_dur, `Straight
| Sub, [TDate; TDate] -> Sub_dat_dat, `Straight
| Sub, [TDate; TDuration] -> Sub_dat_dur, `Straight
| Mult, [TInt; TInt] -> Mult_int_int, `Straight
| Mult, [TRat; TRat] -> Mult_rat_rat, `Straight
| Mult, [TMoney; TRat] -> Mult_mon_rat, `Straight
| Mult, [TRat; TMoney] -> Mult_mon_rat, `Reversed
| Mult, [TDuration; TInt] -> Mult_dur_int, `Straight
| Mult, [TInt; TDuration] -> Mult_dur_int, `Reversed
| Div, [TInt; TInt] -> Div_int_int, `Straight
| Div, [TRat; TRat] -> Div_rat_rat, `Straight
| Div, [TMoney; TMoney] -> Div_mon_mon, `Straight
| Div, [TMoney; TRat] -> Div_mon_rat, `Straight
| Lt, [TInt; TInt] -> Lt_int_int, `Straight
| Lt, [TRat; TRat] -> Lt_rat_rat, `Straight
| Lt, [TMoney; TMoney] -> Lt_mon_mon, `Straight
| Lt, [TDuration; TDuration] -> Lt_dur_dur, `Straight
| Lt, [TDate; TDate] -> Lt_dat_dat, `Straight
| Lte, [TInt; TInt] -> Lte_int_int, `Straight
| Lte, [TRat; TRat] -> Lte_rat_rat, `Straight
| Lte, [TMoney; TMoney] -> Lte_mon_mon, `Straight
| Lte, [TDuration; TDuration] -> Lte_dur_dur, `Straight
| Lte, [TDate; TDate] -> Lte_dat_dat, `Straight
| Gt, [TInt; TInt] -> Gt_int_int, `Straight
| Gt, [TRat; TRat] -> Gt_rat_rat, `Straight
| Gt, [TMoney; TMoney] -> Gt_mon_mon, `Straight
| Gt, [TDuration; TDuration] -> Gt_dur_dur, `Straight
| Gt, [TDate; TDate] -> Gt_dat_dat, `Straight
| Gte, [TInt; TInt] -> Gte_int_int, `Straight
| Gte, [TRat; TRat] -> Gte_rat_rat, `Straight
| Gte, [TMoney; TMoney] -> Gte_mon_mon, `Straight
| Gte, [TDuration; TDuration] -> Gte_dur_dur, `Straight
| Gte, [TDate; TDate] -> Gte_dat_dat, `Straight
| (Minus | Add | Sub | Mult | Div | Lt | Lte | Gt | Gte), _ -> raise Not_found
let resolve_overload
ctx
(op : ('a, overloaded) t Marked.pos)
(operands : typ list) : ('b, resolved) t * [ `Straight | `Reversed ] =
try
let operands =
List.map
(fun t ->
match Marked.unmark t with TLit tl -> tl | _ -> raise Not_found)
operands
in
resolve_overload_aux (Marked.unmark op) operands
with Not_found ->
Errors.raise_multispanned_error
((None, Marked.get_mark op)
:: List.map
(fun ty ->
( Some
(Format.asprintf "Type %a coming from expression:"
(Print.typ ctx) ty),
Marked.get_mark ty ))
operands)
"I don't know how to apply operator %a on types %a" Print.operator
(Marked.unmark op)
(Format.pp_print_list
~pp_sep:(fun ppf () -> Format.fprintf ppf " and@ ")
(Print.typ ctx))
operands
let overload_type ctx (op : ('a, overloaded) t Marked.pos) (operands : typ list)
: typ =
let rop = fst (resolve_overload ctx op operands) in
resolved_type (Marked.same_mark_as rop op)
Reference in New Issue Copy Permalink