Source file ast.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
(* This file is part of the Catala compiler, a specification language for tax
   and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
   Denis Merigoux <denis.merigoux@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
include Shared_ast

type lit = lcalc glit

type 'm naked_expr = (lcalc, 'm mark) naked_gexpr
and 'm expr = (lcalc, 'm mark) gexpr

type 'm program = 'm expr Shared_ast.program

let option_enum : EnumName.t = EnumName.fresh ("eoption", Pos.no_pos)
let none_constr : EnumConstructor.t = EnumConstructor.fresh ("ENone", Pos.no_pos)
let some_constr : EnumConstructor.t = EnumConstructor.fresh ("ESome", Pos.no_pos)

let option_enum_config : typ EnumConstructor.Map.t =
  EnumConstructor.Map.empty
  |> EnumConstructor.Map.add none_constr (TLit TUnit, Pos.no_pos)
  |> EnumConstructor.Map.add some_constr (TAny, Pos.no_pos)

(* FIXME: proper typing in all the constructors below *)

let make_none m =
  let tunit = TLit TUnit, Expr.mark_pos m in
  Expr.einj (Expr.elit LUnit (Expr.with_ty m tunit)) none_constr option_enum m

let make_some e =
  let m = Marked.get_mark e in
  Expr.einj e some_constr option_enum m

(** [make_matchopt_with_abs_arms arg e_none e_some] build an expression
    [match arg with |None -> e_none | Some -> e_some] and requires e_some and
    e_none to be in the form [EAbs ...].*)
let make_matchopt_with_abs_arms arg e_none e_some =
  let m = Marked.get_mark arg in
  let cases =
    EnumConstructor.Map.empty
    |> EnumConstructor.Map.add none_constr e_none
    |> EnumConstructor.Map.add some_constr e_some
  in
  Expr.ematch arg option_enum cases m

(** [make_matchopt pos v tau arg e_none e_some] builds an expression
    [match arg with | None () -> e_none | Some v -> e_some]. It binds v to
    e_some, permitting it to be used inside the expression. There is no
    requirements on the form of both e_some and e_none. *)
let make_matchopt pos v tau arg e_none e_some =
  let x = Var.make "_" in
  make_matchopt_with_abs_arms arg
    (Expr.make_abs [| x |] e_none [TLit TUnit, pos] pos)
    (Expr.make_abs [| v |] e_some [tau] pos)

let handle_default = Var.make "handle_default"
let handle_default_opt = Var.make "handle_default_opt"