Erasure of F* to ML

To discuss:
  -- fully applied type constructors (T tau1..taun)

  Revisit this example:
    type  poly2 (x : Type -> Type)  =
     | Poly2 :  t:Type -> x t -> poly2 x

  -- prenex form for polymorphic functions
  -- erasure in epsilon\hat


Source:

 b ::= a:k | x:t
 k ::= Type | b -> k
 t ::= a | b -> M t wp | T | t t (*possibly partial*) | t e (*possibly partial*) | x:t{t'}
 e ::= x | \b.e | e e | e t | C
    | let x : M t = e in e'           // expect let-bound names to have both a type and an effect label
    | let rec f : M t = e in e'
    | match e with {P -> e}
    | e @ t                           // type-ascription
 G ::= b1..bn
 S ::= erased:Type -> Type
    |  T (b1..bn) : k { C : t }

Target:

N ::= MayErase
    |  Keep

mono types:
tau ::= TT               //Obj.t in OCaml; System.Object in F#
      | a                 //type variables
      | tau -> N tau'     //function types, with an explicit N-effect (N will not be printed)
      | T tau1..taun      //fully applied type constructors (TODO: discuss)
      // if the missing argument is a term, \hat{epsilon} applies unit. else it applies Obj.t

poly types:
 s ::= forall a1..an. tau //polymorphic type (sometimes called a type-scheme)

expressions:
 E ::= x <tau1..taun>     //Explicit type applications associated with each variable (will not be printed)
    | \x:tau.e
    | e e
    | C (e1,...,en)           //Fully-applied data constructors
    | let x:s = e in e'       //let is generalized, so the x has a poly type
    | let rec f:s = e in e'   //let rec uses polymorphic recursion in OCaml/F#
    | match e with {P -> e}
    | (e : tau ~> tau')       //Obj.magic e in OCaml; and (e :?> tau') in F# (checked cast)\

contexts:
 G ::= . | x:s | a | G, G'

Define two mutually inductive judgments:

  G_in |- e_in <= N_in  tau_in  || E_out   -- type-and-effect checking, and code gen
  G_in |- e_in => N_out tau_out || E_out   -- type-and-effect synthesis, and code gen

The main invariant:

      erase(G) |- e <= N  tau  || E
  ==> erase(G) |-ML  E : (erase tau)

      G |- e => N tau  || E
  ==> erase(G) |-ML  E : (erase tau)

Some aux. functions
  erasable: a predicate on tau (ML types)

  erasable unit
  erasable (erased tau)
  erasable tau ==> erasable (tau' -> MayErase tau)

  erase (N tau) E = if N=MayErase /\ erasable tau then () else E

  coerce tau tau  E = E
  coerce tau tau' E = (E : tau ~> tau'), when tau <> tau'

Some shorthands:

    G |- e <= N tau | E    \def=   G |- e  <= N tau || (erase (N tau) E)
    G |- e => N tau | E    \def=   G |- e  => N tau || (erase (N tau) E)


  G(x) = tau
 -------------------------------- [Var-Synth]
  G |- x => MayErase (G x) | x

  G(x) = forall a1..an. tau
  taui = epsilon^(ti, G)
  tau' = tau [tau1..taun/a1..an]
 ------------------------------------------------- [InstT-Synth]
  G |- x t1..tn => MayErase tau' | x <tau1..taun>

  G |- e => N' tau1 | E'
  tau1 = unit -> N'' tau'
  N'' `join` N' \leq N
 ------------------------------------------------ [AppT-Check]
  G |- e t <= N tau | coerce tau tau' (E' ())

  G |- e => N' (unit -> N'' tau) | E'
  N'' `join` N' = N
  ---------------------------------------[AppT-Synth]
  G |- e t => N tau | E' ()

  G |- e1 e2 => N' tau' | E
  N' leq N
  -------------------------------------------------------------------[AppE-Check]
  G |- e1 e2 <= N tau | coerce tau' tau E

  G |- e1 => N1 (tau2 -> N' tau) | E1
  G |- e2 => N2 tau2' | E2
  join(N1, N2, N') = N
  ----------------------------------------------------[AppE-Synth]
  G |- e1 e2 => N tau | E1 (coerce tau2' tau2 E2)

  tau = epsilon^(G, t)
  G, x:tau |- e <= N' tau' | E
  ------------------------------------------------- [LamX-Check]
  G |- \x:t. e <= N (tau -> N' tau') | \x:tau. E

  tau = epsilon^(G, t)
  G, x:tau |- e => N tau' | E
  ------------------------------------------------- [LamX-Synth]
  G |- \x:t. e => Tot (tau -> N tau') | \x:tau. E

  G |- e <= N' tau' | E     //context not extended intentionally
  ----------------------------------------------------- [LamT-Check]
  G |- \a:k. e <= N (unit -> N' tau') | \_:unit. E

  G |- e => N tau | E     //context not extended intentionally
  ----------------------------------------------------- [LamT-Synth]
  G |- \a:k. e => Tot (unit -> N tau) | \_:unit. E

  e is a value
  G, a1..an = G'
  N' tau' = epsilon^(M t wp, G')
  G' |- e <= N' tau' | E
  G, x:forall a1..an.tau' |- e' <= N tau | E'    //should all the ki=Type?
  ------------------------------------------------------------------ [LetGen-Check]
  G |- let x : Tot (a1:k1 -> ... -> an:kn -> M t wp) = \a1:k1 .. an:kn. e in e' <= N tau
     | let x : forall a1..an. tau' = E in E'


  e is a value
  G, a1..an = G'     tau = epsilon(t, G')
  N' tau' = epsilon^(M t wp, G')
  G' |- e <= N' tau' | E
  G, x:forall a1..an.tau' |- e' => N tau | E'
  ------------------------------------------------------------------ [LetGen-Synth]
  G |- let x : Tot (a1:k1 -> ... -> an:kn -> M t wp) = \a1:k1 .. an:kn. e in e' => N tau
     | let x : forall a1..an. tau = E in E'

  t <> a:k -> t'
  N' tau' = epsilon^(M t _, G)
  G' |- e <= N' tau' | E
  G, x:tau' |- e' <= N tau | E'
  N' leq N
  ------------------------------------------------------------------ [Let-Check]
  G |- let x : M t = e in e' <= N tau
     | let x : tau' = E in E'

  t <> a:k -> t'
  N' tau' = epsilon^(M t _, G)
  G' |- e <= N' tau' | E
  G, x:tau' |- e' => N'' tau | E'   N = join N' N''
  ------------------------------------------------------------------ [Let-Synth]
  G |- let x : M t = e in e' => N tau | let x : tau' = E in E'
