2020-11-22 22:56:27 +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: 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. *)
|
|
|
|
|
2020-11-23 11:22:47 +03:00
|
|
|
module Pos = Utils.Pos
|
|
|
|
|
2020-11-23 18:12:45 +03:00
|
|
|
type typ =
|
|
|
|
| TBool
|
|
|
|
| TUnit
|
2020-11-24 13:27:23 +03:00
|
|
|
| TInt
|
2020-11-23 18:12:45 +03:00
|
|
|
| TTuple of typ Pos.marked list
|
|
|
|
| TArrow of typ Pos.marked * typ Pos.marked
|
2020-11-22 22:56:27 +03:00
|
|
|
|
2020-11-24 13:27:23 +03:00
|
|
|
type lit = LBool of bool | LEmptyError | LInt of Int64.t
|
|
|
|
|
|
|
|
type binop = And | Or | Add | Sub | Mult | Div | Lt | Lte | Gt | Gte | Eq | Neq
|
|
|
|
|
|
|
|
type unop = Not | Minus
|
|
|
|
|
|
|
|
type operator = Binop of binop | Unop of unop
|
2020-11-22 22:56:27 +03:00
|
|
|
|
|
|
|
type expr =
|
2020-11-23 12:44:06 +03:00
|
|
|
| EVar of expr Pos.marked Bindlib.var
|
2020-11-23 18:12:45 +03:00
|
|
|
| ETuple of expr Pos.marked list
|
|
|
|
| ETupleAccess of expr Pos.marked * int
|
2020-11-22 22:56:27 +03:00
|
|
|
| ELit of lit
|
2020-11-24 12:28:39 +03:00
|
|
|
| EAbs of Pos.t * (expr Pos.marked, expr Pos.marked) Bindlib.mbinder * typ list
|
|
|
|
| EApp of expr Pos.marked * expr Pos.marked list
|
2020-11-24 13:27:23 +03:00
|
|
|
| EOp of operator
|
2020-11-22 22:56:27 +03:00
|
|
|
| EDefault of expr Pos.marked * expr Pos.marked * expr Pos.marked list
|
2020-11-24 00:26:26 +03:00
|
|
|
| EIfThenElse of expr Pos.marked * expr Pos.marked * expr Pos.marked
|
2020-11-22 22:56:27 +03:00
|
|
|
|
|
|
|
module Var = struct
|
2020-11-23 12:44:06 +03:00
|
|
|
type t = expr Pos.marked Bindlib.var
|
2020-11-22 22:56:27 +03:00
|
|
|
|
2020-11-23 20:51:06 +03:00
|
|
|
let make (s : string Pos.marked) =
|
|
|
|
Bindlib.new_var (fun x -> (EVar x, Pos.get_position s)) (Pos.unmark s)
|
|
|
|
|
2020-11-22 22:56:27 +03:00
|
|
|
let compare x y = Bindlib.compare_vars x y
|
|
|
|
end
|
|
|
|
|
2020-11-24 12:28:39 +03:00
|
|
|
type vars = expr Pos.marked Bindlib.mvar
|
|
|
|
|
2020-11-22 22:56:27 +03:00
|
|
|
module VarMap = Map.Make (Var)
|
|
|
|
|
2020-11-23 20:51:06 +03:00
|
|
|
let make_var (x : Var.t) : expr Pos.marked Bindlib.box = Bindlib.box_var x
|
|
|
|
|
2020-11-24 12:28:39 +03:00
|
|
|
let make_abs (xs : vars) (e : expr Pos.marked Bindlib.box) (pos_binder : Pos.t) (taus : typ list)
|
2020-11-23 20:51:06 +03:00
|
|
|
(pos : Pos.t) : expr Pos.marked Bindlib.box =
|
2020-11-24 12:28:39 +03:00
|
|
|
Bindlib.box_apply (fun b -> (EAbs (pos_binder, b, taus), pos)) (Bindlib.bind_mvar xs e)
|
2020-11-23 20:51:06 +03:00
|
|
|
|
2020-11-24 12:28:39 +03:00
|
|
|
let make_app (e : expr Pos.marked Bindlib.box) (u : expr Pos.marked Bindlib.box list) (pos : Pos.t)
|
|
|
|
: expr Pos.marked Bindlib.box =
|
|
|
|
Bindlib.box_apply2 (fun e u -> (EApp (e, u), pos)) e (Bindlib.box_list u)
|
2020-11-23 20:51:06 +03:00
|
|
|
|
2020-11-22 22:56:27 +03:00
|
|
|
type binder = (expr, expr Pos.marked) Bindlib.binder
|