(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, Collège de France and Inria Paris            *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Associating semantics to built-in functions *)
(** This module provides definitions and mechanisms to associate semantics with names of built-in functions.  This module is independent of the target architecture.  Each target provides a [Builtins1] module that lists the built-ins semantics appropriate for the target. *)
Definition val_opt_has_rettype (ov: option val) (t: rettype) : Prop :=
match ov with Some v => Val.has_rettype v t | None => True end.
Definition val_opt_inject (j: meminj) (ov ov': option val) : Prop :=
match ov, ov' with
| None, _ => True
| Some v, Some v' => Val.inject j v v'
| _, None => False
end.
(** The semantics of a built-in function is a partial function from list of values to values. It must agree with the return type stated in the signature, and be compatible with value injections. *)
Record builtin_sem (tret: rettype) : Type := mkbuiltin {
bs_sem :> list val -> option val;
bs_well_typed: forall vl,
val_opt_has_rettype (bs_sem vl) tret;
bs_inject: forall j vl vl',
Val.inject_list j vl vl' -> val_opt_inject j (bs_sem vl) (bs_sem vl')
}.
(** Builtin functions can be created from functions over values, such as those from the [Values.Val] module.  Proofs of well-typedness and compatibility with injections must be provided. The constructor functions have names - [mkbuiltin_vNt] for a [t]otal function of [N] arguments that are [v]alues, or - [mkbuiltin_vNp] for a [p]artial function of [N] arguments that are [v]alues. *)
Local Unset Program Cases.
Program Definition mkbuiltin_v1t
(tret: rettype) (f: val -> val)
(WT: forall v1, Val.has_rettype (f v1) tret)
(INJ: forall j v1 v1', Val.inject j v1 v1' -> Val.inject j (f v1) (f v1')) :=
mkbuiltin tret (fun vl => match vl with v1 :: nil => Some (f v1) | _ => None end) _ _.
Next Obligation.
red; destruct vl; auto. destruct vl; auto.
Qed.
Next Obligation.
red; inv H; auto. inv H1; auto.
Qed.
Program Definition mkbuiltin_v2t
(tret: rettype) (f: val -> val -> val)
(WT: forall v1 v2, Val.has_rettype (f v1 v2) tret)
(INJ: forall j v1 v1' v2 v2',
Val.inject j v1 v1' -> Val.inject j v2 v2' ->
Val.inject j (f v1 v2) (f v1' v2')) :=
mkbuiltin tret (fun vl => match vl with v1 :: v2 :: nil => Some (f v1 v2) | _ => None end) _ _.
Next Obligation.
red; destruct vl; auto. destruct vl; auto. destruct vl; auto.
Qed.
Next Obligation.
red; inv H; auto. inv H1; auto. inv H2; auto.
Qed.
Program Definition mkbuiltin_v3t
(tret: rettype) (f: val -> val -> val -> val)
(WT: forall v1 v2 v3, Val.has_rettype (f v1 v2 v3) tret)
(INJ: forall j v1 v1' v2 v2' v3 v3',
Val.inject j v1 v1' -> Val.inject j v2 v2' -> Val.inject j v3 v3' ->
Val.inject j (f v1 v2 v3) (f v1' v2' v3')) :=
mkbuiltin tret (fun vl => match vl with v1 :: v2 :: v3 :: nil => Some (f v1 v2 v3) | _ => None end) _ _.
Next Obligation.
red; destruct vl; auto. destruct vl; auto. destruct vl; auto. destruct vl; auto.
Qed.
Next Obligation.
red; inv H; auto. inv H1; auto. inv H2; auto. inv H3; auto.
Qed.
Program Definition mkbuiltin_v1p
(tret: rettype) (f: val -> option val)
(WT: forall v1, val_opt_has_rettype (f v1) tret)
(INJ: forall j v1 v1',
Val.inject j v1 v1' -> val_opt_inject j (f v1) (f v1')) :=
mkbuiltin tret (fun vl => match vl with v1 :: nil => f v1 | _ => None end) _ _.
Next Obligation.
red; destruct vl; auto. destruct vl; auto. apply WT.
Qed.
Next Obligation.
red; inv H; auto. inv H1; auto. apply INJ; auto.
Qed.
Program Definition mkbuiltin_v2p
(tret: rettype) (f: val -> val -> option val)
(WT: forall v1 v2, val_opt_has_rettype (f v1 v2) tret)
(INJ: forall j v1 v1' v2 v2',
Val.inject j v1 v1' -> Val.inject j v2 v2' ->
val_opt_inject j (f v1 v2) (f v1' v2')) :=
mkbuiltin tret (fun vl => match vl with v1 :: v2 :: nil => f v1 v2 | _ => None end)  _ _.
Next Obligation.
red; destruct vl; auto. destruct vl; auto. destruct vl; auto. apply WT.
Qed.
Next Obligation.
red; inv H; auto. inv H1; auto. inv H2; auto. apply INJ; auto.
Qed.
(** For numerical functions, involving only integers and floating-point numbers but no pointer values, we can automate the proofs of well-typedness and of compatibility with injections. *)
(** First we define a mapping from syntactic Cminor types ([Tint], [Tfloat], etc) to semantic Coq types. *)
Definition valty (t: typ) : Type :=
match t with
| Tint => int
| Tlong => int64
| Tfloat => float
| Tsingle => float32
| Tany32 | Tany64 => Empty_set (**r no clear semantic meaning *)
end.
(** We can inject and project between the numerical type [valty t] and the type [val]. *)
Definition inj_num (t: typ) : valty t -> val :=
match t with
| Tint => Vint
| Tlong => Vlong
| Tfloat => Vfloat
| Tsingle => Vsingle
| Tany32 | Tany64 => fun _ => Vundef
end.
Definition proj_num {A: Type} (t: typ) (k0: A) (v: val): (valty t -> A) -> A :=
match t with
| Tint => fun k1 => match v with Vint n => k1 n | _ => k0 end
| Tlong => fun k1 => match v with Vlong n => k1 n | _ => k0 end
| Tfloat => fun k1 => match v with Vfloat n => k1 n | _ => k0 end
| Tsingle => fun k1 => match v with Vsingle n => k1 n | _ => k0 end
| Tany32 | Tany64 => fun k1 => k0
end.

Lemma proj_num_opt_wt:
forall (tres: typ) t k0 k1 v,
k0 = None \/ k0 = Some Vundef ->
(forall x, val_opt_has_rettype (k1 x) tres) ->
val_opt_has_rettype (proj_num t k0 v k1) tres.