mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-20 00:41:05 +03:00
Added date and durations handling
This commit is contained in:
parent
0038a1ea2d
commit
902c3f8d7d
3
Makefile
3
Makefile
@ -23,7 +23,8 @@ install-dependencies-ocaml:
|
|||||||
unionfind \
|
unionfind \
|
||||||
bindlib \
|
bindlib \
|
||||||
zarith \
|
zarith \
|
||||||
ocamlgraph
|
ocamlgraph \
|
||||||
|
odate
|
||||||
|
|
||||||
init-submodules:
|
init-submodules:
|
||||||
git submodule update --init
|
git submodule update --init
|
||||||
|
@ -20,7 +20,15 @@ type ident = string
|
|||||||
|
|
||||||
type qident = ident Pos.marked list
|
type qident = ident Pos.marked list
|
||||||
|
|
||||||
type primitive_typ = Integer | Decimal | Boolean | Money | Text | Date | Named of constructor
|
type primitive_typ =
|
||||||
|
| Integer
|
||||||
|
| Decimal
|
||||||
|
| Boolean
|
||||||
|
| Money
|
||||||
|
| Duration
|
||||||
|
| Text
|
||||||
|
| Date
|
||||||
|
| Named of constructor
|
||||||
|
|
||||||
type base_typ_data =
|
type base_typ_data =
|
||||||
| Primitive of primitive_typ
|
| Primitive of primitive_typ
|
||||||
@ -55,7 +63,7 @@ type enum_decl = {
|
|||||||
|
|
||||||
type match_case_pattern = constructor Pos.marked list * ident Pos.marked option
|
type match_case_pattern = constructor Pos.marked list * ident Pos.marked option
|
||||||
|
|
||||||
type op_kind = KInt | KDec | KMoney
|
type op_kind = KInt | KDec | KMoney | KDate | KDuration
|
||||||
|
|
||||||
type binop =
|
type binop =
|
||||||
| And
|
| And
|
||||||
|
@ -20,7 +20,12 @@ module Cli = Utils.Cli
|
|||||||
a redefinition of a subvariable *)
|
a redefinition of a subvariable *)
|
||||||
|
|
||||||
let translate_op_kind (k : Ast.op_kind) : Dcalc.Ast.op_kind =
|
let translate_op_kind (k : Ast.op_kind) : Dcalc.Ast.op_kind =
|
||||||
match k with KInt -> KInt | KDec -> KRat | KMoney -> KMoney
|
match k with
|
||||||
|
| KInt -> KInt
|
||||||
|
| KDec -> KRat
|
||||||
|
| KMoney -> KMoney
|
||||||
|
| KDate -> KDate
|
||||||
|
| KDuration -> KDuration
|
||||||
|
|
||||||
let translate_binop (op : Ast.binop) : Dcalc.Ast.binop =
|
let translate_binop (op : Ast.binop) : Dcalc.Ast.binop =
|
||||||
match op with
|
match op with
|
||||||
@ -88,7 +93,24 @@ let rec translate_expr (scope : Scopelang.Ast.ScopeName.t)
|
|||||||
| MoneyAmount i ->
|
| MoneyAmount i ->
|
||||||
Scopelang.Ast.ELit
|
Scopelang.Ast.ELit
|
||||||
(Dcalc.Ast.LMoney Z.((i.money_amount_units * of_int 100) + i.money_amount_cents))
|
(Dcalc.Ast.LMoney Z.((i.money_amount_units * of_int 100) + i.money_amount_cents))
|
||||||
| _ -> Name_resolution.raise_unsupported_feature "literal" pos
|
| Number ((Int _, _), Some ((Year | Month | Day), _))
|
||||||
|
| Number ((Dec (_, _), _), Some ((Year | Month | Day), _)) ->
|
||||||
|
Name_resolution.raise_unsupported_feature "literal" pos
|
||||||
|
| Date date -> (
|
||||||
|
let date =
|
||||||
|
ODate.Unix.make
|
||||||
|
~year:(Pos.unmark date.literal_date_year)
|
||||||
|
~day:(Pos.unmark date.literal_date_day)
|
||||||
|
~month:
|
||||||
|
( try ODate.Month.of_int (Pos.unmark date.literal_date_month)
|
||||||
|
with Failure _ ->
|
||||||
|
Errors.raise_spanned_error "Invalid month (should be between 1 and 12)"
|
||||||
|
(Pos.get_position date.literal_date_month) )
|
||||||
|
()
|
||||||
|
in
|
||||||
|
match ODate.Unix.some_if_valid date with
|
||||||
|
| Some date -> Scopelang.Ast.ELit (Dcalc.Ast.LDate date)
|
||||||
|
| None -> Errors.raise_spanned_error "Invalid date" pos )
|
||||||
in
|
in
|
||||||
Bindlib.box (untyped_term, pos)
|
Bindlib.box (untyped_term, pos)
|
||||||
| Ident x -> (
|
| Ident x -> (
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
(library
|
(library
|
||||||
(name surface)
|
(name surface)
|
||||||
(libraries utils menhirLib sedlex re desugared scopelang zarith)
|
(libraries utils menhirLib sedlex re desugared scopelang zarith odate)
|
||||||
(public_name catala.surface)
|
(public_name catala.surface)
|
||||||
(preprocess
|
(preprocess
|
||||||
(pps sedlex.ppx)))
|
(pps sedlex.ppx)))
|
||||||
|
@ -69,6 +69,7 @@ let token_list : (string * token) list =
|
|||||||
("text", TEXT);
|
("text", TEXT);
|
||||||
("decimal", DECIMAL);
|
("decimal", DECIMAL);
|
||||||
("date", DATE);
|
("date", DATE);
|
||||||
|
("duration", DURATION);
|
||||||
("boolean", BOOLEAN);
|
("boolean", BOOLEAN);
|
||||||
("sum", SUM);
|
("sum", SUM);
|
||||||
("ok", FILLED);
|
("ok", FILLED);
|
||||||
@ -167,6 +168,9 @@ let rec lex_code (lexbuf : lexbuf) : token =
|
|||||||
| "date" ->
|
| "date" ->
|
||||||
update_acc lexbuf;
|
update_acc lexbuf;
|
||||||
DATE
|
DATE
|
||||||
|
| "duration" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
DURATION
|
||||||
| "bool" ->
|
| "bool" ->
|
||||||
update_acc lexbuf;
|
update_acc lexbuf;
|
||||||
BOOLEAN
|
BOOLEAN
|
||||||
@ -301,6 +305,42 @@ let rec lex_code (lexbuf : lexbuf) : token =
|
|||||||
| "->" ->
|
| "->" ->
|
||||||
update_acc lexbuf;
|
update_acc lexbuf;
|
||||||
ARROW
|
ARROW
|
||||||
|
| "<=@" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
LESSER_EQUAL_DATE
|
||||||
|
| "<@" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
LESSER_DATE
|
||||||
|
| ">=@" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
GREATER_EQUAL_DATE
|
||||||
|
| ">@" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
GREATER_DATE
|
||||||
|
| "-@" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
MINUSDATE
|
||||||
|
| "+@" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
PLUSDATE
|
||||||
|
| "<=^" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
LESSER_EQUAL_DURATION
|
||||||
|
| "<^" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
LESSER_DURATION
|
||||||
|
| ">=^" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
GREATER_EQUAL_DURATION
|
||||||
|
| ">^" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
GREATER_DURATION
|
||||||
|
| "+^" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
PLUSDURATION
|
||||||
|
| "-^" ->
|
||||||
|
update_acc lexbuf;
|
||||||
|
MINUSDURATION
|
||||||
| "<=", 0x24 ->
|
| "<=", 0x24 ->
|
||||||
update_acc lexbuf;
|
update_acc lexbuf;
|
||||||
LESSER_EQUAL_MONEY
|
LESSER_EQUAL_MONEY
|
||||||
|
@ -37,6 +37,7 @@ let token_list_en : (string * token) list =
|
|||||||
("text", TEXT);
|
("text", TEXT);
|
||||||
("decimal", DECIMAL);
|
("decimal", DECIMAL);
|
||||||
("date", DATE);
|
("date", DATE);
|
||||||
|
("duration", DURATION);
|
||||||
("boolean", BOOLEAN);
|
("boolean", BOOLEAN);
|
||||||
("sum", SUM);
|
("sum", SUM);
|
||||||
("fulfilled", FILLED);
|
("fulfilled", FILLED);
|
||||||
@ -135,6 +136,9 @@ let rec lex_code_en (lexbuf : lexbuf) : token =
|
|||||||
| "date" ->
|
| "date" ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
DATE
|
DATE
|
||||||
|
| "duration" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
DURATION
|
||||||
| "boolean" ->
|
| "boolean" ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
BOOLEAN
|
BOOLEAN
|
||||||
@ -269,6 +273,42 @@ let rec lex_code_en (lexbuf : lexbuf) : token =
|
|||||||
| "->" ->
|
| "->" ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
ARROW
|
ARROW
|
||||||
|
| "<=@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_EQUAL_DATE
|
||||||
|
| "<@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_DATE
|
||||||
|
| ">=@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_EQUAL_DATE
|
||||||
|
| ">@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_DATE
|
||||||
|
| "-@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
MINUSDATE
|
||||||
|
| "+@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
PLUSDATE
|
||||||
|
| "<=^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_EQUAL_DURATION
|
||||||
|
| "<^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_DURATION
|
||||||
|
| ">=^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_EQUAL_DURATION
|
||||||
|
| ">^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_DURATION
|
||||||
|
| "+^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
PLUSDURATION
|
||||||
|
| "-^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
MINUSDURATION
|
||||||
| "<=", 0x24 ->
|
| "<=", 0x24 ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
LESSER_EQUAL_MONEY
|
LESSER_EQUAL_MONEY
|
||||||
|
@ -37,6 +37,7 @@ let token_list_fr : (string * token) list =
|
|||||||
("texte", TEXT);
|
("texte", TEXT);
|
||||||
("decimal", DECIMAL);
|
("decimal", DECIMAL);
|
||||||
("date", DATE);
|
("date", DATE);
|
||||||
|
("durée", DURATION);
|
||||||
("booléen", BOOLEAN);
|
("booléen", BOOLEAN);
|
||||||
("somme", SUM);
|
("somme", SUM);
|
||||||
("rempli", FILLED);
|
("rempli", FILLED);
|
||||||
@ -136,6 +137,9 @@ let rec lex_code_fr (lexbuf : lexbuf) : token =
|
|||||||
| "date" ->
|
| "date" ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
DATE
|
DATE
|
||||||
|
| "dur", 0xE9, "e" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
DURATION
|
||||||
| "bool", 0xE9, "en" ->
|
| "bool", 0xE9, "en" ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
BOOLEAN
|
BOOLEAN
|
||||||
@ -278,6 +282,42 @@ let rec lex_code_fr (lexbuf : lexbuf) : token =
|
|||||||
| "->" ->
|
| "->" ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
ARROW
|
ARROW
|
||||||
|
| "<=@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_EQUAL_DATE
|
||||||
|
| "<@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_DATE
|
||||||
|
| ">=@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_EQUAL_DATE
|
||||||
|
| ">@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_DATE
|
||||||
|
| "-@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
MINUSDATE
|
||||||
|
| "+@" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
PLUSDATE
|
||||||
|
| "<=^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_EQUAL_DURATION
|
||||||
|
| "<^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
LESSER_DURATION
|
||||||
|
| ">=^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_EQUAL_DURATION
|
||||||
|
| ">^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
GREATER_DURATION
|
||||||
|
| "+^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
PLUSDURATION
|
||||||
|
| "-^" ->
|
||||||
|
L.update_acc lexbuf;
|
||||||
|
MINUSDURATION
|
||||||
| "<=", 0x20AC ->
|
| "<=", 0x20AC ->
|
||||||
L.update_acc lexbuf;
|
L.update_acc lexbuf;
|
||||||
LESSER_EQUAL_MONEY
|
LESSER_EQUAL_MONEY
|
||||||
|
@ -104,7 +104,8 @@ let process_base_typ (ctxt : context) ((typ, typ_pos) : Ast.base_typ Pos.marked)
|
|||||||
| Ast.Integer -> (Scopelang.Ast.TLit TInt, typ_pos)
|
| Ast.Integer -> (Scopelang.Ast.TLit TInt, typ_pos)
|
||||||
| Ast.Decimal -> (Scopelang.Ast.TLit TRat, typ_pos)
|
| Ast.Decimal -> (Scopelang.Ast.TLit TRat, typ_pos)
|
||||||
| Ast.Money -> (Scopelang.Ast.TLit TMoney, typ_pos)
|
| Ast.Money -> (Scopelang.Ast.TLit TMoney, typ_pos)
|
||||||
| Ast.Date -> raise_unsupported_feature "date type" typ_pos
|
| Ast.Duration -> (Scopelang.Ast.TLit TDuration, typ_pos)
|
||||||
|
| Ast.Date -> (Scopelang.Ast.TLit TDate, typ_pos)
|
||||||
| Ast.Boolean -> (Scopelang.Ast.TLit TBool, typ_pos)
|
| Ast.Boolean -> (Scopelang.Ast.TLit TBool, typ_pos)
|
||||||
| Ast.Text -> raise_unsupported_feature "text type" typ_pos
|
| Ast.Text -> raise_unsupported_feature "text type" typ_pos
|
||||||
| Ast.Named ident -> (
|
| Ast.Named ident -> (
|
||||||
|
@ -45,15 +45,18 @@
|
|||||||
%token LESSER GREATER LESSER_EQUAL GREATER_EQUAL
|
%token LESSER GREATER LESSER_EQUAL GREATER_EQUAL
|
||||||
%token LESSER_DEC GREATER_DEC LESSER_EQUAL_DEC GREATER_EQUAL_DEC
|
%token LESSER_DEC GREATER_DEC LESSER_EQUAL_DEC GREATER_EQUAL_DEC
|
||||||
%token LESSER_MONEY GREATER_MONEY LESSER_EQUAL_MONEY GREATER_EQUAL_MONEY
|
%token LESSER_MONEY GREATER_MONEY LESSER_EQUAL_MONEY GREATER_EQUAL_MONEY
|
||||||
|
%token LESSER_DATE GREATER_DATE LESSER_EQUAL_DATE GREATER_EQUAL_DATE
|
||||||
|
%token LESSER_DURATION GREATER_DURATION LESSER_EQUAL_DURATION GREATER_EQUAL_DURATION
|
||||||
%token EXISTS IN SUCH THAT NOW
|
%token EXISTS IN SUCH THAT NOW
|
||||||
%token DOT AND OR LPAREN RPAREN OPTIONAL EQUAL
|
%token DOT AND OR LPAREN RPAREN OPTIONAL EQUAL
|
||||||
%token CARDINAL ASSERTION FIXED BY YEAR
|
%token CARDINAL ASSERTION FIXED BY YEAR
|
||||||
%token PLUS MINUS MULT DIV
|
%token PLUS MINUS MULT DIV
|
||||||
%token PLUSDEC MINUSDEC MULTDEC DIVDEC
|
%token PLUSDEC MINUSDEC MULTDEC DIVDEC
|
||||||
%token PLUSMONEY MINUSMONEY MULTMONEY DIVMONEY
|
%token PLUSMONEY MINUSMONEY MULTMONEY DIVMONEY
|
||||||
|
%token MINUSDATE PLUSDATE PLUSDURATION MINUSDURATION
|
||||||
%token MATCH WITH VARIES WITH_V
|
%token MATCH WITH VARIES WITH_V
|
||||||
%token FOR ALL WE_HAVE INCREASING DECREASING
|
%token FOR ALL WE_HAVE INCREASING DECREASING
|
||||||
%token NOT BOOLEAN PERCENT ARROW
|
%token NOT BOOLEAN PERCENT ARROW DURATION
|
||||||
%token SCOPE FILLED NOT_EQUAL DEFINITION
|
%token SCOPE FILLED NOT_EQUAL DEFINITION
|
||||||
%token STRUCT CONTENT IF THEN DEPENDS DECLARATION
|
%token STRUCT CONTENT IF THEN DEPENDS DECLARATION
|
||||||
%token CONTEXT ENUM ELSE DATE SUM
|
%token CONTEXT ENUM ELSE DATE SUM
|
||||||
@ -70,6 +73,7 @@ typ_base:
|
|||||||
| INTEGER { (Integer, $sloc) }
|
| INTEGER { (Integer, $sloc) }
|
||||||
| BOOLEAN { (Boolean, $sloc) }
|
| BOOLEAN { (Boolean, $sloc) }
|
||||||
| MONEY { (Money, $sloc) }
|
| MONEY { (Money, $sloc) }
|
||||||
|
| DURATION { (Duration, $sloc) }
|
||||||
| TEXT { (Text, $sloc) }
|
| TEXT { (Text, $sloc) }
|
||||||
| DECIMAL { (Decimal, $sloc) }
|
| DECIMAL { (Decimal, $sloc) }
|
||||||
| DATE { (Date, $sloc) }
|
| DATE { (Date, $sloc) }
|
||||||
@ -194,6 +198,14 @@ compare_op:
|
|||||||
| LESSER_EQUAL_MONEY { (Lte KMoney, $sloc) }
|
| LESSER_EQUAL_MONEY { (Lte KMoney, $sloc) }
|
||||||
| GREATER_MONEY { (Gt KMoney, $sloc) }
|
| GREATER_MONEY { (Gt KMoney, $sloc) }
|
||||||
| GREATER_EQUAL_MONEY { (Gte KMoney, $sloc) }
|
| GREATER_EQUAL_MONEY { (Gte KMoney, $sloc) }
|
||||||
|
| LESSER_DATE { (Lt KDate, $sloc) }
|
||||||
|
| LESSER_EQUAL_DATE { (Lte KDate, $sloc) }
|
||||||
|
| GREATER_DATE { (Gt KDate, $sloc) }
|
||||||
|
| GREATER_EQUAL_DATE { (Gte KDate, $sloc) }
|
||||||
|
| LESSER_DURATION { (Lt KDuration, $sloc) }
|
||||||
|
| LESSER_EQUAL_DURATION { (Lte KDuration, $sloc) }
|
||||||
|
| GREATER_DURATION { (Gt KDuration, $sloc) }
|
||||||
|
| GREATER_EQUAL_DURATION { (Gte KDuration, $sloc) }
|
||||||
| EQUAL { (Eq, $sloc) }
|
| EQUAL { (Eq, $sloc) }
|
||||||
| NOT_EQUAL { (Neq, $sloc) }
|
| NOT_EQUAL { (Neq, $sloc) }
|
||||||
|
|
||||||
@ -235,6 +247,10 @@ mult_expression:
|
|||||||
}
|
}
|
||||||
|
|
||||||
sum_op:
|
sum_op:
|
||||||
|
| PLUSDURATION { (Add KDuration, $sloc) }
|
||||||
|
| MINUSDURATION { (Sub KDuration, $sloc) }
|
||||||
|
| PLUSDATE { (Add KDate, $sloc) }
|
||||||
|
| MINUSDATE { (Sub KDate, $sloc) }
|
||||||
| PLUSMONEY { (Add KMoney, $sloc) }
|
| PLUSMONEY { (Add KMoney, $sloc) }
|
||||||
| MINUSMONEY { (Sub KMoney, $sloc) }
|
| MINUSMONEY { (Sub KMoney, $sloc) }
|
||||||
| PLUSDEC { (Add KDec, $sloc) }
|
| PLUSDEC { (Add KDec, $sloc) }
|
||||||
@ -246,6 +262,7 @@ sum_unop:
|
|||||||
| MINUS { (Minus KInt, $sloc) }
|
| MINUS { (Minus KInt, $sloc) }
|
||||||
| MINUSDEC { (Minus KDec, $sloc) }
|
| MINUSDEC { (Minus KDec, $sloc) }
|
||||||
| MINUSMONEY { (Minus KMoney, $sloc) }
|
| MINUSMONEY { (Minus KMoney, $sloc) }
|
||||||
|
| MINUSDURATION { (Minus KDuration, $sloc) }
|
||||||
|
|
||||||
sum_expression:
|
sum_expression:
|
||||||
| e = mult_expression { e }
|
| e = mult_expression { e }
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
module Pos = Utils.Pos
|
module Pos = Utils.Pos
|
||||||
module Uid = Utils.Uid
|
module Uid = Utils.Uid
|
||||||
|
|
||||||
type typ_lit = TBool | TUnit | TInt | TRat | TMoney
|
type typ_lit = TBool | TUnit | TInt | TRat | TMoney | TDate | TDuration
|
||||||
|
|
||||||
type typ =
|
type typ =
|
||||||
| TLit of typ_lit
|
| TLit of typ_lit
|
||||||
@ -23,9 +23,26 @@ type typ =
|
|||||||
| TEnum of typ Pos.marked list
|
| TEnum of typ Pos.marked list
|
||||||
| TArrow of typ Pos.marked * typ Pos.marked
|
| TArrow of typ Pos.marked * typ Pos.marked
|
||||||
|
|
||||||
type lit = LBool of bool | LEmptyError | LInt of Z.t | LRat of Q.t | LMoney of Z.t | LUnit
|
type date = ODate.Unix.t
|
||||||
|
|
||||||
type op_kind = KInt | KRat | KMoney
|
type duration = ODate.Unix.d
|
||||||
|
|
||||||
|
type lit =
|
||||||
|
| LBool of bool
|
||||||
|
| LEmptyError
|
||||||
|
| LInt of Z.t
|
||||||
|
| LRat of Q.t
|
||||||
|
| LMoney of Z.t
|
||||||
|
| LUnit
|
||||||
|
| LDate of date
|
||||||
|
| LDuration of duration
|
||||||
|
|
||||||
|
type op_kind =
|
||||||
|
| KInt
|
||||||
|
| KRat
|
||||||
|
| KMoney
|
||||||
|
| KDate
|
||||||
|
| KDuration (** All ops don't have a Kdate and KDuration *)
|
||||||
|
|
||||||
type binop =
|
type binop =
|
||||||
| And
|
| And
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
(library
|
(library
|
||||||
(name dcalc)
|
(name dcalc)
|
||||||
(public_name catala.dcalc)
|
(public_name catala.dcalc)
|
||||||
(libraries bindlib unionFind utils zarith))
|
(libraries bindlib unionFind utils zarith odate))
|
||||||
|
|
||||||
(documentation
|
(documentation
|
||||||
(package catala))
|
(package catala))
|
||||||
|
@ -68,6 +68,14 @@ let evaluate_operator (op : A.operator Pos.marked) (args : A.expr Pos.marked lis
|
|||||||
(Some "The division operator:", Pos.get_position op);
|
(Some "The division operator:", Pos.get_position op);
|
||||||
(Some "The null denominator:", Pos.get_position (List.nth args 2));
|
(Some "The null denominator:", Pos.get_position (List.nth args 2));
|
||||||
]
|
]
|
||||||
|
| A.Binop (A.Add KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
A.ELit (LDuration (ODuration.( + ) i1 i2))
|
||||||
|
| A.Binop (A.Sub KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
A.ELit (LDuration (ODuration.( - ) i1 i2))
|
||||||
|
| A.Binop (A.Sub KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
|
||||||
|
A.ELit (LDuration (ODate.Unix.between i1 i2))
|
||||||
|
| A.Binop (A.Add KDate), [ ELit (LDate i1); ELit (LDuration i2) ] ->
|
||||||
|
A.ELit (LDate (ODate.Unix.move i1 i2))
|
||||||
| A.Binop (A.Lt KInt), [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 < i2))
|
| A.Binop (A.Lt KInt), [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 < i2))
|
||||||
| A.Binop (A.Lte KInt), [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 <= i2))
|
| A.Binop (A.Lte KInt), [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 <= i2))
|
||||||
| A.Binop (A.Gt KInt), [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 > i2))
|
| A.Binop (A.Gt KInt), [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 > i2))
|
||||||
@ -76,10 +84,41 @@ let evaluate_operator (op : A.operator Pos.marked) (args : A.expr Pos.marked lis
|
|||||||
| A.Binop (A.Lte KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 <= i2))
|
| A.Binop (A.Lte KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 <= i2))
|
||||||
| A.Binop (A.Gt KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 > i2))
|
| A.Binop (A.Gt KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 > i2))
|
||||||
| A.Binop (A.Gte KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 >= i2))
|
| A.Binop (A.Gte KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 >= i2))
|
||||||
|
| A.Binop (A.Lt KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
let diff = ODuration.( - ) i2 i1 in
|
||||||
|
A.ELit (LBool (ODuration.is_positive diff))
|
||||||
|
| A.Binop (A.Lte KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
let diff = ODuration.( - ) i2 i1 in
|
||||||
|
A.ELit (LBool (ODuration.is_positive diff || ODuration.is_instantenous diff))
|
||||||
|
| A.Binop (A.Gt KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
let diff = ODuration.( - ) i2 i1 in
|
||||||
|
A.ELit (LBool (ODuration.is_negative diff))
|
||||||
|
| A.Binop (A.Gte KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
let diff = ODuration.( - ) i2 i1 in
|
||||||
|
A.ELit (LBool (ODuration.is_negative diff || ODuration.is_instantenous diff))
|
||||||
|
| A.Binop (A.Lt KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
|
||||||
|
A.ELit (LBool (ODate.Unix.compare i1 i2 < 0))
|
||||||
|
| A.Binop (A.Lte KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
|
||||||
|
A.ELit (LBool (ODate.Unix.compare i1 i2 <= 0))
|
||||||
|
| A.Binop (A.Gt KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
|
||||||
|
A.ELit (LBool (ODate.Unix.compare i1 i2 > 0))
|
||||||
|
| A.Binop (A.Gte KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
|
||||||
|
A.ELit (LBool (ODate.Unix.compare i1 i2 >= 0))
|
||||||
|
| A.Binop A.Eq, [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
let diff = ODuration.( - ) i2 i1 in
|
||||||
|
A.ELit (LBool (ODuration.is_instantenous diff))
|
||||||
|
| A.Binop A.Eq, [ ELit (LDate i1); ELit (LDate i2) ] ->
|
||||||
|
A.ELit (LBool (ODate.Unix.compare i1 i2 = 0))
|
||||||
| A.Binop A.Eq, [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 = i2))
|
| A.Binop A.Eq, [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 = i2))
|
||||||
| A.Binop A.Eq, [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 = i2))
|
| A.Binop A.Eq, [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 = i2))
|
||||||
| A.Binop A.Eq, [ ELit (LBool b1); ELit (LBool b2) ] -> A.ELit (LBool (b1 = b2))
|
| A.Binop A.Eq, [ ELit (LBool b1); ELit (LBool b2) ] -> A.ELit (LBool (b1 = b2))
|
||||||
| A.Binop A.Eq, [ _; _ ] -> A.ELit (LBool false) (* comparing functions return false *)
|
| A.Binop A.Eq, [ _; _ ] -> A.ELit (LBool false) (* comparing functions return false *)
|
||||||
|
| A.Binop A.Neq, [ ELit (LDuration i1); ELit (LDuration i2) ] ->
|
||||||
|
let diff = ODuration.( - ) i2 i1 in
|
||||||
|
A.ELit (LBool (not (ODuration.is_instantenous diff)))
|
||||||
|
| A.Binop A.Neq, [ ELit (LDate i1); ELit (LDate i2) ] ->
|
||||||
|
A.ELit (LBool (ODate.Unix.compare i1 i2 <> 0))
|
||||||
|
| A.Binop A.Neq, [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Q.(i1 <> i2))
|
||||||
| A.Binop A.Neq, [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 <> i2))
|
| A.Binop A.Neq, [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool (i1 <> i2))
|
||||||
| A.Binop A.Neq, [ ELit (LBool b1); ELit (LBool b2) ] -> A.ELit (LBool (b1 <> b2))
|
| A.Binop A.Neq, [ ELit (LBool b1); ELit (LBool b2) ] -> A.ELit (LBool (b1 <> b2))
|
||||||
| A.Binop A.Neq, [ _; _ ] -> A.ELit (LBool true)
|
| A.Binop A.Neq, [ _; _ ] -> A.ELit (LBool true)
|
||||||
@ -97,9 +136,11 @@ let evaluate_operator (op : A.operator Pos.marked) (args : A.expr Pos.marked lis
|
|||||||
| A.Unop _, [ ELit LEmptyError ] -> A.ELit LEmptyError
|
| A.Unop _, [ ELit LEmptyError ] -> A.ELit LEmptyError
|
||||||
| _ ->
|
| _ ->
|
||||||
Errors.raise_multispanned_error
|
Errors.raise_multispanned_error
|
||||||
"operator applied to the wrong arguments (should not happen if the term was well-typed)"
|
"Operator applied to the wrong arguments\n(should nothappen if the term was well-typed)"
|
||||||
[ (Some "Operator:", Pos.get_position op) ]
|
( [ (Some "Operator:", Pos.get_position op) ]
|
||||||
@@ List.mapi (fun i arg -> Some ("Argument n°" ^ string_of_int i, Pos.get_position arg)) )
|
@ List.mapi
|
||||||
|
(fun i arg -> (Some ("Argument n°" ^ string_of_int (i + 1)), Pos.get_position arg))
|
||||||
|
args ) )
|
||||||
op
|
op
|
||||||
|
|
||||||
let rec evaluate_expr (e : A.expr Pos.marked) : A.expr Pos.marked =
|
let rec evaluate_expr (e : A.expr Pos.marked) : A.expr Pos.marked =
|
||||||
|
@ -18,17 +18,23 @@ open Ast
|
|||||||
let typ_needs_parens (e : typ Pos.marked) : bool =
|
let typ_needs_parens (e : typ Pos.marked) : bool =
|
||||||
match Pos.unmark e with TArrow _ -> true | _ -> false
|
match Pos.unmark e with TArrow _ -> true | _ -> false
|
||||||
|
|
||||||
|
let format_tlit (fmt : Format.formatter) (l : typ_lit) : unit =
|
||||||
|
match l with
|
||||||
|
| TUnit -> Format.fprintf fmt "unit"
|
||||||
|
| TBool -> Format.fprintf fmt "boolean"
|
||||||
|
| TInt -> Format.fprintf fmt "integer"
|
||||||
|
| TRat -> Format.fprintf fmt "decimal"
|
||||||
|
| TMoney -> Format.fprintf fmt "money"
|
||||||
|
| TDuration -> Format.fprintf fmt "duration"
|
||||||
|
| TDate -> Format.fprintf fmt "date"
|
||||||
|
|
||||||
let rec format_typ (fmt : Format.formatter) (typ : typ Pos.marked) : unit =
|
let rec format_typ (fmt : Format.formatter) (typ : typ Pos.marked) : unit =
|
||||||
let format_typ_with_parens (fmt : Format.formatter) (t : typ Pos.marked) =
|
let format_typ_with_parens (fmt : Format.formatter) (t : typ Pos.marked) =
|
||||||
if typ_needs_parens t then Format.fprintf fmt "(%a)" format_typ t
|
if typ_needs_parens t then Format.fprintf fmt "(%a)" format_typ t
|
||||||
else Format.fprintf fmt "%a" format_typ t
|
else Format.fprintf fmt "%a" format_typ t
|
||||||
in
|
in
|
||||||
match Pos.unmark typ with
|
match Pos.unmark typ with
|
||||||
| TLit TUnit -> Format.fprintf fmt "unit"
|
| TLit l -> Format.fprintf fmt "%a" format_tlit l
|
||||||
| TLit TBool -> Format.fprintf fmt "boolean"
|
|
||||||
| TLit TInt -> Format.fprintf fmt "integer"
|
|
||||||
| TLit TRat -> Format.fprintf fmt "decimal"
|
|
||||||
| TLit TMoney -> Format.fprintf fmt "money"
|
|
||||||
| TTuple ts ->
|
| TTuple ts ->
|
||||||
Format.fprintf fmt "(%a)"
|
Format.fprintf fmt "(%a)"
|
||||||
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt " *@ ") format_typ)
|
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt " *@ ") format_typ)
|
||||||
@ -82,9 +88,18 @@ let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
|
|||||||
( if List.length !digits - leading_zeroes !digits = !Utils.Cli.max_prec_digits then "…"
|
( if List.length !digits - leading_zeroes !digits = !Utils.Cli.max_prec_digits then "…"
|
||||||
else "" )
|
else "" )
|
||||||
| LMoney e -> Format.fprintf fmt "$%.2f" Q.(to_float (of_bigint e / of_int 100))
|
| LMoney e -> Format.fprintf fmt "$%.2f" Q.(to_float (of_bigint e / of_int 100))
|
||||||
|
| LDate d ->
|
||||||
|
Format.fprintf fmt "%s"
|
||||||
|
(ODate.Unix.To.string (Option.get (ODate.Unix.To.generate_printer "%Y-%m-%d")) d)
|
||||||
|
| LDuration d ->
|
||||||
|
Format.fprintf fmt "%s"
|
||||||
|
(ODuration.To.string
|
||||||
|
(Option.get (ODuration.To.generate_printer "[%Y] years or [%M] months of [%D] days"))
|
||||||
|
d)
|
||||||
|
|
||||||
let format_op_kind (fmt : Format.formatter) (k : op_kind) =
|
let format_op_kind (fmt : Format.formatter) (k : op_kind) =
|
||||||
Format.fprintf fmt "%s" (match k with KInt -> "" | KRat -> "." | KMoney -> "$")
|
Format.fprintf fmt "%s"
|
||||||
|
(match k with KInt -> "" | KRat -> "." | KMoney -> "$" | KDate -> "@" | KDuration -> "^")
|
||||||
|
|
||||||
let format_binop (fmt : Format.formatter) (op : binop Pos.marked) : unit =
|
let format_binop (fmt : Format.formatter) (op : binop Pos.marked) : unit =
|
||||||
match Pos.unmark op with
|
match Pos.unmark op with
|
||||||
|
@ -30,11 +30,7 @@ type typ =
|
|||||||
let rec format_typ (fmt : Format.formatter) (ty : typ Pos.marked UnionFind.elem) : unit =
|
let rec format_typ (fmt : Format.formatter) (ty : typ Pos.marked UnionFind.elem) : unit =
|
||||||
let ty_repr = UnionFind.get (UnionFind.find ty) in
|
let ty_repr = UnionFind.get (UnionFind.find ty) in
|
||||||
match Pos.unmark ty_repr with
|
match Pos.unmark ty_repr with
|
||||||
| TLit TUnit -> Format.fprintf fmt "unit"
|
| TLit l -> Format.fprintf fmt "%a" Print.format_tlit l
|
||||||
| TLit TBool -> Format.fprintf fmt "bool"
|
|
||||||
| TLit TInt -> Format.fprintf fmt "int"
|
|
||||||
| TLit TRat -> Format.fprintf fmt "dec"
|
|
||||||
| TLit TMoney -> Format.fprintf fmt "money"
|
|
||||||
| TAny -> Format.fprintf fmt "any type"
|
| TAny -> Format.fprintf fmt "any type"
|
||||||
| TTuple ts ->
|
| TTuple ts ->
|
||||||
Format.fprintf fmt "(%a)"
|
Format.fprintf fmt "(%a)"
|
||||||
@ -52,9 +48,17 @@ let rec unify (t1 : typ Pos.marked UnionFind.elem) (t2 : typ Pos.marked UnionFin
|
|||||||
let t2_repr = UnionFind.get (UnionFind.find t2) in
|
let t2_repr = UnionFind.get (UnionFind.find t2) in
|
||||||
match (t1_repr, t2_repr) with
|
match (t1_repr, t2_repr) with
|
||||||
| (TLit tl1, _), (TLit tl2, _) when tl1 = tl2 -> ()
|
| (TLit tl1, _), (TLit tl2, _) when tl1 = tl2 -> ()
|
||||||
| (TArrow (t11, t12), _), (TArrow (t21, t22), _) ->
|
| (TArrow (t11, t12), t1_pos), (TArrow (t21, t22), t2_pos) -> (
|
||||||
unify t11 t21;
|
try
|
||||||
unify t12 t22
|
unify t11 t21;
|
||||||
|
unify t12 t22
|
||||||
|
with Errors.StructuredError (msg, err_pos) ->
|
||||||
|
Errors.raise_multispanned_error msg
|
||||||
|
( err_pos
|
||||||
|
@ [
|
||||||
|
(Some (Format.asprintf "Type %a coming from expression:" format_typ t1), t1_pos);
|
||||||
|
(Some (Format.asprintf "Type %a coming from expression:" format_typ t2), t2_pos);
|
||||||
|
] ) )
|
||||||
| (TTuple ts1, _), (TTuple ts2, _) -> List.iter2 unify ts1 ts2
|
| (TTuple ts1, _), (TTuple ts2, _) -> List.iter2 unify ts1 ts2
|
||||||
| (TEnum ts1, _), (TEnum ts2, _) -> List.iter2 unify ts1 ts2
|
| (TEnum ts1, _), (TEnum ts2, _) -> List.iter2 unify ts1 ts2
|
||||||
| (TAny, _), (TAny, _) -> ignore (UnionFind.union t1 t2)
|
| (TAny, _), (TAny, _) -> ignore (UnionFind.union t1 t2)
|
||||||
@ -78,6 +82,8 @@ let op_type (op : A.operator Pos.marked) : typ Pos.marked UnionFind.elem =
|
|||||||
let it = UnionFind.make (TLit TInt, pos) in
|
let it = UnionFind.make (TLit TInt, pos) in
|
||||||
let rt = UnionFind.make (TLit TRat, pos) in
|
let rt = UnionFind.make (TLit TRat, pos) in
|
||||||
let mt = UnionFind.make (TLit TMoney, pos) in
|
let mt = UnionFind.make (TLit TMoney, pos) in
|
||||||
|
let dut = UnionFind.make (TLit TDuration, pos) in
|
||||||
|
let dat = UnionFind.make (TLit TDate, pos) in
|
||||||
let any = UnionFind.make (TAny, pos) in
|
let any = UnionFind.make (TAny, pos) in
|
||||||
let arr x y = UnionFind.make (TArrow (x, y), pos) in
|
let arr x y = UnionFind.make (TArrow (x, y), pos) in
|
||||||
match Pos.unmark op with
|
match Pos.unmark op with
|
||||||
@ -85,17 +91,26 @@ let op_type (op : A.operator Pos.marked) : typ Pos.marked UnionFind.elem =
|
|||||||
| A.Binop (A.Add KInt | A.Sub KInt | A.Mult KInt | A.Div KInt) -> arr it (arr it it)
|
| A.Binop (A.Add KInt | A.Sub KInt | A.Mult KInt | A.Div KInt) -> arr it (arr it it)
|
||||||
| A.Binop (A.Add KRat | A.Sub KRat | A.Mult KRat | A.Div KRat) -> arr rt (arr rt rt)
|
| A.Binop (A.Add KRat | A.Sub KRat | A.Mult KRat | A.Div KRat) -> arr rt (arr rt rt)
|
||||||
| A.Binop (A.Add KMoney | A.Sub KMoney) -> arr mt (arr mt mt)
|
| A.Binop (A.Add KMoney | A.Sub KMoney) -> arr mt (arr mt mt)
|
||||||
|
| A.Binop (A.Add KDuration | A.Sub KDuration) -> arr dut (arr dut dut)
|
||||||
|
| A.Binop (A.Sub KDate) -> arr dat (arr dat dut)
|
||||||
|
| A.Binop (A.Add KDate) -> arr dat (arr dut dat)
|
||||||
| A.Binop (A.Div KMoney) -> arr mt (arr mt rt)
|
| A.Binop (A.Div KMoney) -> arr mt (arr mt rt)
|
||||||
| A.Binop (A.Mult KMoney) -> arr mt (arr rt mt)
|
| A.Binop (A.Mult KMoney) -> arr mt (arr rt mt)
|
||||||
| A.Binop (A.Lt KInt | A.Lte KInt | A.Gt KInt | A.Gte KInt) -> arr it (arr it bt)
|
| A.Binop (A.Lt KInt | A.Lte KInt | A.Gt KInt | A.Gte KInt) -> arr it (arr it bt)
|
||||||
| A.Binop (A.Lt KRat | A.Lte KRat | A.Gt KRat | A.Gte KRat) -> arr rt (arr rt bt)
|
| A.Binop (A.Lt KRat | A.Lte KRat | A.Gt KRat | A.Gte KRat) -> arr rt (arr rt bt)
|
||||||
| A.Binop (A.Lt KMoney | A.Lte KMoney | A.Gt KMoney | A.Gte KMoney) -> arr mt (arr mt bt)
|
| A.Binop (A.Lt KMoney | A.Lte KMoney | A.Gt KMoney | A.Gte KMoney) -> arr mt (arr mt bt)
|
||||||
|
| A.Binop (A.Lt KDate | A.Lte KDate | A.Gt KDate | A.Gte KDate) -> arr dat (arr dat bt)
|
||||||
|
| A.Binop (A.Lt KDuration | A.Lte KDuration | A.Gt KDuration | A.Gte KDuration) ->
|
||||||
|
arr dut (arr dut bt)
|
||||||
| A.Binop (A.Eq | A.Neq) -> arr any (arr any bt)
|
| A.Binop (A.Eq | A.Neq) -> arr any (arr any bt)
|
||||||
| A.Unop (A.Minus KInt) -> arr it it
|
| A.Unop (A.Minus KInt) -> arr it it
|
||||||
| A.Unop (A.Minus KRat) -> arr rt rt
|
| A.Unop (A.Minus KRat) -> arr rt rt
|
||||||
| A.Unop (A.Minus KMoney) -> arr mt mt
|
| A.Unop (A.Minus KMoney) -> arr mt mt
|
||||||
|
| A.Unop (A.Minus KDuration) -> arr dut dut
|
||||||
| A.Unop A.Not -> arr bt bt
|
| A.Unop A.Not -> arr bt bt
|
||||||
| A.Unop A.ErrorOnEmpty -> arr any any
|
| A.Unop A.ErrorOnEmpty -> arr any any
|
||||||
|
| Binop (Mult (KDate | KDuration)) | Binop (Div (KDate | KDuration)) | Unop (Minus KDate) ->
|
||||||
|
Errors.raise_spanned_error "This operator is not available!" pos
|
||||||
|
|
||||||
let rec ast_to_typ (ty : A.typ) : typ =
|
let rec ast_to_typ (ty : A.typ) : typ =
|
||||||
match ty with
|
match ty with
|
||||||
@ -133,6 +148,8 @@ let rec typecheck_expr_bottom_up (env : env) (e : A.expr Pos.marked) : typ Pos.m
|
|||||||
| ELit (LInt _) -> UnionFind.make (Pos.same_pos_as (TLit TInt) e)
|
| ELit (LInt _) -> UnionFind.make (Pos.same_pos_as (TLit TInt) e)
|
||||||
| ELit (LRat _) -> UnionFind.make (Pos.same_pos_as (TLit TRat) e)
|
| ELit (LRat _) -> UnionFind.make (Pos.same_pos_as (TLit TRat) e)
|
||||||
| ELit (LMoney _) -> UnionFind.make (Pos.same_pos_as (TLit TMoney) e)
|
| ELit (LMoney _) -> UnionFind.make (Pos.same_pos_as (TLit TMoney) e)
|
||||||
|
| ELit (LDate _) -> UnionFind.make (Pos.same_pos_as (TLit TDate) e)
|
||||||
|
| ELit (LDuration _) -> UnionFind.make (Pos.same_pos_as (TLit TDuration) e)
|
||||||
| ELit LUnit -> UnionFind.make (Pos.same_pos_as (TLit TUnit) e)
|
| ELit LUnit -> UnionFind.make (Pos.same_pos_as (TLit TUnit) e)
|
||||||
| ELit LEmptyError -> UnionFind.make (Pos.same_pos_as TAny e)
|
| ELit LEmptyError -> UnionFind.make (Pos.same_pos_as TAny e)
|
||||||
| ETuple es ->
|
| ETuple es ->
|
||||||
@ -236,6 +253,8 @@ and typecheck_expr_top_down (env : env) (e : A.expr Pos.marked)
|
|||||||
| ELit (LInt _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TInt) e))
|
| ELit (LInt _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TInt) e))
|
||||||
| ELit (LRat _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TRat) e))
|
| ELit (LRat _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TRat) e))
|
||||||
| ELit (LMoney _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TMoney) e))
|
| ELit (LMoney _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TMoney) e))
|
||||||
|
| ELit (LDate _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TDate) e))
|
||||||
|
| ELit (LDuration _) -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TDuration) e))
|
||||||
| ELit LUnit -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TUnit) e))
|
| ELit LUnit -> unify tau (UnionFind.make (Pos.same_pos_as (TLit TUnit) e))
|
||||||
| ELit LEmptyError -> unify tau (UnionFind.make (Pos.same_pos_as TAny e))
|
| ELit LEmptyError -> unify tau (UnionFind.make (Pos.same_pos_as TAny e))
|
||||||
| ETuple es -> (
|
| ETuple es -> (
|
||||||
|
@ -37,11 +37,7 @@ let rec format_typ (fmt : Format.formatter) (typ : typ Pos.marked) : unit =
|
|||||||
else Format.fprintf fmt "%a" format_typ t
|
else Format.fprintf fmt "%a" format_typ t
|
||||||
in
|
in
|
||||||
match Pos.unmark typ with
|
match Pos.unmark typ with
|
||||||
| TLit TUnit -> Format.fprintf fmt "unit"
|
| TLit l -> Dcalc.Print.format_tlit fmt l
|
||||||
| TLit TBool -> Format.fprintf fmt "boolean"
|
|
||||||
| TLit TInt -> Format.fprintf fmt "integer"
|
|
||||||
| TLit TRat -> Format.fprintf fmt "decimal"
|
|
||||||
| TLit TMoney -> Format.fprintf fmt "money"
|
|
||||||
| TStruct s -> Format.fprintf fmt "%a" Ast.StructName.format_t s
|
| TStruct s -> Format.fprintf fmt "%a" Ast.StructName.format_t s
|
||||||
| TEnum e -> Format.fprintf fmt "%a" Ast.EnumName.format_t e
|
| TEnum e -> Format.fprintf fmt "%a" Ast.EnumName.format_t e
|
||||||
| TArrow (t1, t2) ->
|
| TArrow (t1, t2) ->
|
||||||
|
13
tests/test_date/simple.catala
Normal file
13
tests/test_date/simple.catala
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
@Article@
|
||||||
|
|
||||||
|
/*
|
||||||
|
new scope A:
|
||||||
|
param x content date
|
||||||
|
param y content date
|
||||||
|
param z content duration
|
||||||
|
|
||||||
|
scope A:
|
||||||
|
def x := |01/01/2019|
|
||||||
|
def y := |30/09/2002|
|
||||||
|
def z := x -@ y
|
||||||
|
*/
|
Loading…
Reference in New Issue
Block a user