135 lines
4.1 KiB
OCaml
135 lines
4.1 KiB
OCaml
(* This is the target calculus of the sample client. It is a core System F. *)
|
|
|
|
(* -------------------------------------------------------------------------- *)
|
|
|
|
(* Types. *)
|
|
|
|
(* We include recursive types [FTyMu] in the target calculus, not only because
|
|
we might wish to support them, but also because even if we disallow them,
|
|
they can still arise during unification (the occurs check is run late), so
|
|
we must be able to display them as part of a type error message. *)
|
|
|
|
(* Nominal or de Bruijn representation of type variables and binders. The
|
|
nominal representation is more convenient when translating from ML to F,
|
|
while the de Bruijn representation is more convenient when type-checking
|
|
F. *)
|
|
|
|
type range =
|
|
Lexing.position * Lexing.position
|
|
|
|
val dummy_range: range
|
|
|
|
type ('a, 'b) typ =
|
|
| TyVar of 'a
|
|
| TyArrow of ('a, 'b) typ * ('a, 'b) typ
|
|
| TyProduct of ('a,'b) typ list
|
|
| TyForall of 'b * ('a, 'b) typ
|
|
| TyMu of 'b * ('a, 'b) typ
|
|
| TyConstr of ('a, 'b) datatype
|
|
| TyEq of ('a, 'b) typ * ('a, 'b) typ
|
|
|
|
and ('a, 'b) datatype = Datatype.tyconstr_id * ('a, 'b) typ list
|
|
|
|
type tyvar =
|
|
int
|
|
|
|
type nominal_type =
|
|
(tyvar, tyvar) typ
|
|
|
|
type nominal_datatype =
|
|
(tyvar, tyvar) datatype
|
|
|
|
type debruijn_type =
|
|
(DeBruijn.index, unit) typ
|
|
|
|
type nominal_datatype_env =
|
|
(tyvar, nominal_type) Datatype.Env.t
|
|
|
|
type debruijn_datatype_env =
|
|
(unit, debruijn_type) Datatype.Env.t
|
|
|
|
(* -------------------------------------------------------------------------- *)
|
|
|
|
(* Terms. *)
|
|
|
|
(* Nominal representation of term variables and binders. *)
|
|
|
|
(* Nominal or de Bruijn representation of type variables and binders. *)
|
|
|
|
type tevar =
|
|
string
|
|
|
|
type ('a, 'b) term =
|
|
| Var of range * tevar
|
|
| Hole of range * ('a, 'b) typ * ('a, 'b) term list
|
|
| Annot of range * ('a, 'b) term * ('a, 'b) typ
|
|
| Abs of range * tevar * ('a, 'b) typ * ('a, 'b) term
|
|
| App of range * ('a, 'b) term * ('a, 'b) term
|
|
| Let of range * tevar * ('a, 'b) term * ('a, 'b) term
|
|
| TyAbs of range * 'b * ('a, 'b) term
|
|
| TyApp of range * ('a, 'b) term * ('a, 'b) typ
|
|
| Tuple of range * ('a, 'b) term list
|
|
| Proj of range * int * ('a, 'b) term
|
|
| LetProd of range * tevar list * ('a, 'b) term * ('a, 'b) term
|
|
| Variant of range * Datatype.label_id * ('a, 'b) datatype * ('a,'b) term
|
|
| Match of range * ('a,'b) typ * ('a,'b) term * ('a,'b) branch list
|
|
| Absurd of range * ('a,'b) typ
|
|
| Refl of range * ('a,'b) typ
|
|
| Use of range * ('a,'b) term * ('a,'b) term
|
|
|
|
and ('a,'b) branch = ('a,'b) pattern * ('a,'b) term
|
|
|
|
and ('a,'b) pattern =
|
|
| PVar of range * tevar
|
|
| PAnnot of range * ('a, 'b) pattern * ('a, 'b) typ
|
|
| PWildcard of range
|
|
| PTuple of range * ('a,'b) pattern list
|
|
| PVariant of range * Datatype.label_id * ('a, 'b) datatype * ('a,'b) pattern
|
|
|
|
type nominal_term =
|
|
(tyvar, tyvar) term
|
|
|
|
type nominal_pattern =
|
|
(tyvar, tyvar) pattern
|
|
|
|
type nominal_branch =
|
|
nominal_pattern * nominal_term
|
|
|
|
type debruijn_term =
|
|
(DeBruijn.index, unit) term
|
|
|
|
(* -------------------------------------------------------------------------- *)
|
|
|
|
(* Constructors. *)
|
|
|
|
val ftyabs: 'b list -> ('a, 'b) term -> ('a, 'b) term
|
|
val ftyapp: ('a, 'b) term -> ('a, 'b) typ list -> ('a, 'b) term
|
|
|
|
(* -------------------------------------------------------------------------- *)
|
|
|
|
module Type : sig
|
|
(* Type-in-type weakening and substitution. *)
|
|
|
|
(* [lift w k ty] is the type [ty] where the variables at or above index [k]
|
|
are lifted up by [w]. *)
|
|
val lift: int -> DeBruijn.index -> debruijn_type -> debruijn_type
|
|
|
|
(* [subst xty x ty] is the type [ty] where the type variable [x] has been
|
|
replaced with the type [xty]. *)
|
|
val subst: debruijn_type -> DeBruijn.index -> debruijn_type -> debruijn_type
|
|
|
|
(* Translation of nominal types to de Bruijn types. *)
|
|
val translate: nominal_type -> debruijn_type
|
|
val translate_open: DeBruijn.Nominal2deBruijn(Int).env -> nominal_type -> debruijn_type
|
|
end
|
|
|
|
(* -------------------------------------------------------------------------- *)
|
|
|
|
module Term : sig
|
|
|
|
(* Translation of nominal terms to de Bruijn terms. *)
|
|
val translate: nominal_term -> debruijn_term
|
|
end
|
|
|
|
val translate_env: nominal_datatype_env -> debruijn_datatype_env
|