From stdpp Require Import gmap base relations.
From iris Require Import prelude.
From semantics.ts.systemf Require Import lang notation types tactics.

(** Exercise 3 (LN Exercise 22): Universal Fun *)

Definition fun_comp : val :=
  Λ, Λ, Λ, λ: "f" "g" "x", "g" ("f" "x").
Definition fun_comp_type : type :=
  ∀: ∀: ∀: (#2 → #1) → (#1 → #0) → #2 → #0.
Lemma fun_comp_typed :
  TY 0; ∅ ⊢ fun_comp : fun_comp_type.
Proof. 
  (* should be solved by solve_typing. *)
  solve_typing. 
Qed.

Definition swap_args : val :=
  Λ, Λ, Λ, λ: "f" "x" "y", "f" "y" "x".
Definition swap_args_type : type :=
  ∀: ∀: ∀: (#2 → #1 → #0) → #1 → #2 → #0.
Lemma swap_args_typed :
  TY 0; ∅ ⊢ swap_args : swap_args_type.
Proof. 
  (* should be solved by solve_typing. *)
  solve_typing. 
Qed.

Definition lift_prod : val :=
  Λ, Λ, Λ, Λ, λ: "f" "g" "p", ("f" (Fst "p"), "g" (Snd "p")).
Definition lift_prod_type : type :=
  (∀: ∀: ∀: ∀: (#3 → #1) → (#2 → #0) → #3 × #2 → #1 × #0).
Lemma lift_prod_typed :
  TY 0; ∅ ⊢ lift_prod : lift_prod_type.
Proof. 
  (* should be solved by solve_typing. *)
  solve_typing. 
Qed.

Definition lift_sum : val :=
  Λ, Λ, Λ, Λ, λ: "f" "g" "s",
    match: "s" with
      InjL "x" => InjL ("f" "x")
    | InjR "x" => InjR ("g" "x")
    end.
Definition lift_sum_type : type :=
  (∀: ∀: ∀: ∀: (#3 → #1) → (#2 → #0) → #3 + #2 → #1 + #0).
Lemma lift_sum_typed :
  TY 0; ∅ ⊢ lift_sum : lift_sum_type.
Proof. 
  (* should be solved by solve_typing. *)
  solve_typing. 
Qed.

(** Exercise 5 (LN Exercise 18): Named to De Bruijn *)
Inductive ptype : Type :=
  | PTVar : string → ptype
  | PInt
  | PBool
  | PTForall : string → ptype → ptype
  | PTExists : string → ptype → ptype
  | PFun (A B : ptype).

Declare Scope PType_scope.
Delimit Scope PType_scope with pty.
Bind Scope PType_scope with ptype.
Coercion PTVar: string >-> ptype.
Infix "→" := PFun : PType_scope.
Notation "∀:  x , τ" :=
    (PTForall x τ%pty)
    (at level 100, τ at level 200) : PType_scope.
Notation "∃:  x , τ" :=
    (PTExists x τ%pty)
    (at level 100, τ at level 200) : PType_scope.

Fixpoint debruijn (m: gmap string nat) (A: ptype) : option type :=
   match A with
  | PTVar x => match m !! x with None => None | Some n => Some (TVar n) end
  | PInt => Some Int
  | PBool => Some Bool
  | PFun A B => match debruijn m A, debruijn m B with Some A, Some B => Some (A → B)%ty | _, _ => None end
  | PTForall x A =>
    let m' := <[x := 0]> (S <$> m) in
    match debruijn m' A with None => None | Some A => Some (TForall A) end
  | PTExists x A =>
    let m' := <[x := 0]> (S <$> m) in
    match debruijn m' A with None => None | Some A => Some (TExists A) end
  end.

(* Example *)
Goal debruijn ∅ (∀: "x", ∀: "y", "x" → "y")%pty = Some (∀: ∀: #1 → #0)%ty.
Proof.
  (* Should be solved by reflexivity. *)
  reflexivity.
Qed.

Goal debruijn ∅ (∀: "x", "x" → ∀: "y", "y")%pty = Some (∀: #0 → ∀: #0)%ty.
Proof.
  (* Should be solved by reflexivity. *)
  reflexivity.
Qed.

Goal debruijn ∅ (∀: "x", "x" → ∀: "y", "x")%pty = Some (∀: #0 → ∀: #1)%ty.
Proof.
  (* Should be solved by reflexivity. *)
  reflexivity.
Qed.