I have been stuck with this for more than an hour. So the test bench is at the bottom, and the answer is supposed to show 120 but I keep getting 20. I believe it only does 5 * 4 not the rest of 3 2 and 1.
What is the problem??
I tried to fix all the other ones but they seem correct. is it a calculation error? is it WHILE problem?
type exp =
| NUM of int | TRUE | FALSE | UNIT
| VAR of id
| ADD of exp * exp
| SUB of exp * exp
| MUL of exp * exp
| DIV of exp * exp
| EQUAL of exp * exp
| LESS of exp * exp
| NOT of exp
| SEQ of exp * exp (* sequence *)
| IF of exp * exp * exp (* if-then-else *)
| WHILE of exp * exp (* while loop *)
| LETV of id * exp * exp (* variable binding *)
| LETF of id * id list * exp * exp (* procedure binding *)
| CALLV of id * exp list (* call by value *)
| CALLR of id * id list (* call by referenece *)
| RECORD of (id * exp) list (* record construction *)
| FIELD of exp * id (* access record field *)
| ASSIGN of id * exp (* assgin to variable *)
| ASSIGNF of exp * id * exp (* assign to record field *)
| WRITE of exp
and id = string
type loc = int
type value =
| Num of int
| Bool of bool
| Unit
| Record of record
and record = (id * loc) list
type memory = (loc * value) list
type env = binding list
and binding = LocBind of id * loc | ProcBind of id * proc
and proc = id list * exp * env
(********************************)
(* Handling environment *)
(********************************)
let rec lookup_loc_env : id -> env -> loc
= fun x env ->
match env with
| [] -> raise(Failure ("Variable "^x^" is not included in environment"))
| hd::tl ->
begin match hd with
| LocBind (id,l) -> if(x=id) then l else lookup_loc_env x tl
| ProcBind _ -> lookup_loc_env x tl
end
let rec lookup_proc_env : id -> env -> proc
= fun x env ->
match env with
| [] -> raise(Failure ("Variable "^x^" is not included in environment"))
| hd::tl ->
begin match hd with
| LocBind _ -> lookup_proc_env x tl
| ProcBind (id,binding) -> if (x=id) then binding else lookup_proc_env x tl
end
let extend_env : binding -> env -> env
= fun e env -> e::env
let empty_env = []`enter code here`
(***************************)
(* Handling memory *)
(***************************)
let rec lookup_mem : loc -> memory -> value
= fun l mem ->
match mem with
| [] -> raise(Failure ("location "^(string_of_int l)^" is not included in memory"))
| (loc,v)::tl -> if(l=loc) then v else lookup_mem l tl
let extend_mem : (loc * value) -> memory -> memory
= fun (l,v) mem -> (l,v)::mem
let empty_mem = []
(***************************)
(* Handling record *)
(***************************)
let rec lookup_record : id -> record -> loc
= fun id record ->
match record with
| [] -> raise(Failure ("field "^ id ^" is not included in record"))
| (x,l)::tl -> if(id=x) then l else lookup_record id tl
let extend_record : (id * loc) -> record -> record
= fun (x,l) record -> (x,l)::record
let empty_record = []
(***************************)
let counter = ref 0
let new_location () = counter:=!counter+1;!counter
exception NotImplemented
exception UndefinedSemantics
let rec list_fold2 : ('a -> 'b -> 'c -> 'c)-> 'a list -> 'b list -> 'c -> 'c
= fun func l1 l2 acc ->
match (l1,l2) with
| ([],[]) -> acc
| (hd1::tl1,hd2::tl2) -> list_fold2 func tl1 tl2 (func hd1 hd2 acc)
| _ -> raise (Failure "two lists have different length")
let rec list_fold : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
= fun func l acc ->
match l with
| [] -> acc
| hd::tl -> list_fold func tl (func hd acc)
let value2str : value -> string
= fun v ->
match v with
| Num n -> string_of_int n
| Bool b -> string_of_bool b
| Unit -> "unit"
| Record _ -> "record"
let rec eval_aop : env -> memory -> exp -> exp -> (int -> int -> int) -> (value * memory)
= fun env mem e1 e2 op ->
let (v1,mem1) = eval env mem e1 in
let (v2,mem2) = eval env mem1 e2 in
match (v1,v2) with
| (Num n1, Num n2) -> (Num (op n1 n2), mem2)
| _ -> raise (Failure "arithmetic operation type error")
and eval : env -> memory -> exp -> (value * memory)
=fun env mem e ->
match e with
| NUM n -> (Num n, mem)
| TRUE -> (Bool true, mem)
| FALSE -> (Bool false, mem)
| UNIT -> (Unit, mem)
| VAR x -> ((lookup_mem (lookup_loc_env x env) mem ), mem )
| ADD (e1, e2) -> eval_aop env mem e1 e2 (+)
| SUB (e1, e2) -> eval_aop env mem e1 e2 (-)
| MUL (e1, e2) -> eval_aop env mem e1 e2 ( * )
| DIV (e1, e2) -> eval_aop env mem e1 e2 (/)
|EQUAL (e1, e2) ->
let (v1, mem1) = eval env mem e1 in
let (v2, mem2) = eval env mem1 e2 in
if v1 = v2 then (Bool true, mem2) else (Bool false, mem2)
|LESS (e1, e2) ->
let (v1, mem1) = eval env mem e1 in
let (v2, mem2) = eval env mem1 e2 in
begin match (v1, v2) with
| (Num n1, Num n2) ->
if Num n1 < Num n2 then (Bool true, mem2) else (Bool false, mem2)
| _ -> raise (UndefinedSemantics)
end
|NOT (e1) ->
let (b, mem1) = eval env mem e1 in
if b = b then (Bool false,mem1) else (Bool true,mem1)
|SEQ (e1, e2) ->
let (v1, mem1) = eval env mem e1 in
let (v2, mem2) = eval env mem1 e2 in
(v2,mem2)
|IF (e1,e2,e3) ->
(match (eval env mem e1) with
| (Bool true, mem1) -> eval env mem1 e1
| (Bool false, mem1) -> eval env mem1 e2
| _ -> raise (UndefinedSemantics) )
|WHILE (e1,e2) ->
begin match (eval env mem e1) with
| (Bool true, mem1) ->
let (v1, mem2) = eval env mem1 e2 in
eval env mem2 e2
| (Bool false, mem1) -> (Unit, mem1)
| _ -> raise (UndefinedSemantics)
end
|LETV (x,e1,e2) ->
let (v1, mem1) = eval env mem e1 in
let a = LocBind (x, (new_location()) ) in
let (v2,mem2) = eval (extend_env a env) (extend_mem ((lookup_loc_env x)(extend_env a env), v1) mem1 )e2 in
(v2,mem2)
| ASSIGN (x,e1) ->
let (v1, mem1) = eval env mem e1 in
(v1, extend_mem ((lookup_loc_env x env) , (v1) ) mem1)
| WRITE e ->
let (v1,mem1) = eval env mem e in
let _ = print_endline(value2str v1) in
(v1,mem1)
| _ -> raise NotImplemented
;;
let runb : exp -> value
=fun exp -> let (v, _) = eval empty_env empty_mem exp in v;;
let test = LETV ("ret", NUM 1,
LETV ("n", NUM 5,
SEQ (
WHILE (LESS (NUM 0, VAR "n"),
SEQ (
ASSIGN ("ret", MUL (VAR "ret", VAR "n")),
ASSIGN ("n", SUB (VAR "n", NUM 1))
)
),
VAR "ret")))
;;
runb test;;
When evaluating WHILE you need to make sure the inner expression is evaluated as a WHILE. But you are evaluating it just as itself. In other words, the recursive call to eval should be passing e but you are just passing e2.
As a result you're just getting two evaluations of the loop, which gives 20.
So it seems to me.
I have such type:
type lT = LV of name
| LC of name
| LA of lT * lT
| LAb of name * lT
I want to implement a function called let's say s in a way that, it is gonna behave in the following way:
let println x = printf "%s\n" (s x)
s (`App(`App(`App(`Bs, `K), `K), `K)) ==> "B* K K K”
For this reason, I have implemented the following module:
module type L2C =
sig
val c1 : lT -> ([> `T | `L | `J
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val c2 : lT -> ([> `T | `L | `J | `C | `D
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val c3 : lT -> ([> `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val e : ([< `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b) ->
([ `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b)
end
But since I am new in ocaml, I couldn't manage to create an "s" function to have the output I wanted.
What might be a possible way to do that?
I don't really understand the details of what you're trying to do, but I hope this can help:
let s expr =
let rec loop acc = function
| `Bs -> "B* "^acc
| `K -> "K "^acc
| `App(a,b) -> (loop acc a)^(loop acc b)
in
loop "" expr
The above works pretty well for the example you gave:
s (`App(`App(`App(`Bs, `K), `K), `K));;
- : string = "B* K K K "
You'll need to add extra cases to the pattern-match, and maybe a few type annotations if you want helpful type inference instead of the ugly polymorphic variant types.
In case you do not have to stick to :
s (`App(`App(`App(`Bs, `K), `K), `K)) ==> "B* K K K”
You could use ppx_deriving to automatically produce a function that transform your type into string (example in utop below) :
#require "ppx_deriving.std";;
type t = [`App of (t * t) | `B | `K] [##deriving show];; (* assuming your type is like this *)
> type t = [ `App of t * t | `B | `K ]
> val pp : Format.formatter -> t -> unit = <fun>
> val show : t -> string = <fun> ...
show (`App (`B , `App (`K , `K)));;
- : string = "`App ((`B, `App ((`K, `K))))"
How do you define a simple lambda calculus-like DSL in OCaml using GADTs? Specifically, I can't figure out how to properly define the type checker to translate from an untyped AST to a typed AST nor can I figure out the correct type for the context and environment.
Here's some code for a simple lambda calculus-like language using the traditional approach in OCaml
(* Here's a traditional implementation of a lambda calculus like language *)
type typ =
| Boolean
| Integer
| Arrow of typ*typ
type exp =
| Add of exp*exp
| And of exp*exp
| App of exp*exp
| Lam of string*typ*exp
| Var of string
| Int of int
| Bol of bool
let e1=Add(Int 1,Add(Int 2,Int 3))
let e2=Add(Int 1,Add(Int 2,Bol false)) (* Type error *)
let e3=App(Lam("x",Integer,Add(Var "x",Var "x")),Int 4)
let rec typecheck con e =
match e with
| Add(e1,e2) ->
let t1=typecheck con e1 in
let t2=typecheck con e2 in
begin match (t1,t2) with
| (Integer,Integer) -> Integer
| _ -> failwith "Tried to add with something other than Integers"
end
| And(e1,e2) ->
let t1=typecheck con e1 in
let t2=typecheck con e2 in
begin match (t1,t2) with
| (Boolean,Boolean) -> Boolean
| _ -> failwith "Tried to and with something other than Booleans"
end
| App(e1,e2) ->
let t1=typecheck con e1 in
let t2=typecheck con e2 in
begin match t1 with
| Arrow(t11,t12) ->
if t11 <> t2 then
failwith "Mismatch of types on a function application"
else
t12
| _ -> failwith "Tried to apply a non-arrow type"
end
| Lam(x,t,e) ->
Arrow (t,typecheck ((x,t)::con) e)
| Var x ->
let (y,t) = List.find (fun (y,t)->y=x) con in
t
| Int _ -> Integer
| Bol _ -> Boolean
let t1 = typecheck [] e1
(* let t2 = typecheck [] e2 *)
let t3 = typecheck [] e3
type value =
| VBoolean of bool
| VInteger of int
| VArrow of ((string*value) list -> value -> value)
let rec eval env e =
match e with
| Add(e1,e2) ->
let v1=eval env e1 in
let v2=eval env e2 in
begin match (v1,v2) with
| (VInteger i1,VInteger i2) -> VInteger (i1+i2)
| _ -> failwith "Tried to add with something other than Integers"
end
| And(e1,e2) ->
let v1=eval env e1 in
let v2=eval env e2 in
begin match (v1,v2) with
| (VBoolean b1,VBoolean b2) -> VBoolean (b1 && b2)
| _ -> failwith "Tried to and with something other than Booleans"
end
| App(e1,e2) ->
let v1=eval env e1 in
let v2=eval env e2 in
begin match v1 with
| VArrow a1 -> a1 env v2
| _ -> failwith "Tried to apply a non-arrow type"
end
| Lam(x,t,e) ->
VArrow (fun env' v' -> eval ((x,v')::env') e)
| Var x ->
let (y,v) = List.find (fun (y,t)->y=x) env in
v
| Int i -> VInteger i
| Bol b -> VBoolean b
let v1 = eval [] e1
let v3 = eval [] e3
Now, I'm trying to translate this into something that uses GADTs. Here's my start
(* Now, we try to GADT the process *)
type exp =
| Add of exp*exp
| And of exp*exp
| App of exp*exp
| Lam of string*typ*exp
| Var of string
| Int of int
| Bol of bool
let e1=Add(Int 1,Add(Int 2,Int 3))
let e2=Add(Int 1,Add(Int 2,Bol false))
let e3=App(Lam("x",Integer,Add(Var "x",Var "x")),Int 4)
type _ texp =
| TAdd : int texp * int texp -> int texp
| TAnd : bool texp * bool texp -> bool texp
| TApp : ('a -> 'b) texp * 'a texp -> 'b texp
| TLam : string*'b texp -> ('a -> 'b) texp
| TVar : string -> 'a texp
| TInt : int -> int texp
| TBol : bool -> bool texp
let te1 = TAdd(TInt 1,TAdd(TInt 2,TInt 3))
let rec typecheck : type a. exp -> a texp = fun e ->
match e with
| Add(e1,e2) ->
let te1 = typecheck e1 in
let te2 = typecheck e2 in
TAdd (te1,te2)
| _ -> failwith "todo"
Here's the problem. First, I'm not sure how to define the correct type for TLam and TVar in the type texp. Generally, I would provide the type with the variable name, but I'm not sure how to do that in this context. Second, I don't know the correct type for the context in the function typecheck. Before, I used some kind of list, but now I'm sure sure of the type of the list. Third, after leaving out the context, the typecheck function doesn't type check itself. It fails with the message
File "test03.ml", line 32, characters 8-22:
Error: This expression has type int texp
but an expression was expected of type a texp
Type int is not compatible with type a
which makes complete sense. This is more of an issue of that I'm not sure what the correct type for typecheck should be.
In any case, how do you go about fixing these functions?
Edit 1
Here's a possible type for the context or environment
type _ ctx =
| Empty : unit ctx
| Item : string * 'a * 'b ctx -> ('a*'b) ctx
Edit 2
The trick with the environment is to make sure that the type of the environment is embedded into the type of the expression. Otherwise, there's not enough information in order to make things type safe. Here's a completed interpreter. At the moment, I do not have a valid type checker to move from untyped expressions to typed expressions.
type (_,_) texp =
| TAdd : ('e,int) texp * ('e,int) texp -> ('e,int) texp
| TAnd : ('e,bool) texp * ('e,bool) texp -> ('e,bool) texp
| TApp : ('e,('a -> 'b)) texp * ('e,'a) texp -> ('e,'b) texp
| TLam : (('a*'e),'b) texp -> ('e,('a -> 'b)) texp
| TVar0 : (('a*'e),'a) texp
| TVarS : ('e,'a) texp -> (('b*'e),'a) texp
| TInt : int -> ('e,int) texp
| TBol : bool -> ('e,bool) texp
let te1 = TAdd(TInt 1,TAdd(TInt 2,TInt 3))
(*let te2 = TAdd(TInt 1,TAdd(TInt 2,TBol false))*)
let te3 = TApp(TLam(TAdd(TVar0,TVar0)),TInt 4)
let te4 = TApp(TApp(TLam(TLam(TAdd(TVar0,TVarS(TVar0)))),TInt 4),TInt 5)
let te5 = TLam(TLam(TVarS(TVar0)))
let rec eval : type e t. e -> (e,t) texp -> t = fun env e ->
match e with
| TAdd (e1,e2) ->
let v1 = eval env e1 in
let v2 = eval env e2 in
v1 + v2
| TAnd (e1,e2) ->
let v1 = eval env e1 in
let v2 = eval env e2 in
v1 && v2
| TApp (e1,e2) ->
let v1 = eval env e1 in
let v2 = eval env e2 in
v1 v2
| TLam e ->
fun x -> eval (x,env) e
| TVar0 ->
let (v,vs)=env in
v
| TVarS e ->
let (v,vs)=env in
eval vs e
| TInt i -> i
| TBol b -> b
Then, we have
# eval () te1;;
- : int = 6
# eval () te3;;
- : int = 8
# eval () te5;;
- : '_a -> '_b -> '_a = <fun>
# eval () te4;;
- : int = 9
If you want the term representation to enforce well-typedness, you need to change the way type environments (and variables) are represented: you cannot finely type a mapping from strings to value (type to represent mapping are homogeneous). The classic solution is to move to a representation of variables using De Bruijn indices (strongly-typed numbers) instead of variable names. It may help you to perform that conversion in the untyped world first, and then only care about typing in the untyped -> GADT pass.
Here is, rouhgly sketched, a GADT declaration for strongly typed variables:
type (_, _) var =
| Z : ('a, 'a * 'g) var
| S : ('a, 'g) var -> ('a, 'b * 'g) var
A value at type ('a, 'g) var should be understood as a description of a way to extract a value of type 'a out of an environment of type 'g. The environment is represented by a cascade of right-nested tuples. The Z case corresponds to picking the first variable in the environment, while the S case ignores the topmost variables and looks deeper in the environment.
Shayan Najd has a (Haskell) implementation of this idea on github. Feel free to have a look at the GADT representation or the type-checking/translating code.
Alright, so I finally worked things out. Since I may not be the only one who finds this interesting, here's a complete set of code that does both type checking and evaluation:
type (_,_) texp =
| TAdd : ('gamma,int) texp * ('gamma,int) texp -> ('gamma,int) texp
| TAnd : ('gamma,bool) texp * ('gamma,bool) texp -> ('gamma,bool) texp
| TApp : ('gamma,('t1 -> 't2)) texp * ('gamma,'t1) texp -> ('gamma,'t2) texp
| TLam : (('gamma*'t1),'t2) texp -> ('gamma,('t1 -> 't2)) texp
| TVar0 : (('gamma*'t),'t) texp
| TVarS : ('gamma,'t1) texp -> (('gamma*'t2),'t1) texp
| TInt : int -> ('gamma,int) texp
| TBol : bool -> ('gamma,bool) texp
type _ typ =
| Integer : int typ
| Boolean : bool typ
| Arrow : 'a typ * 'b typ -> ('a -> 'b) typ
type (_,_) iseq = IsEqual : ('a,'a) iseq
let rec is_equal : type a b. a typ -> b typ -> (a,b) iseq option = fun a b ->
match a, b with
| Integer, Integer -> Some IsEqual
| Boolean, Boolean -> Some IsEqual
| Arrow(t1,t2), Arrow(u1,u2) ->
begin match is_equal t1 u1, is_equal t2 u2 with
| Some IsEqual, Some IsEqual -> Some IsEqual
| _ -> None
end
| _ -> None
type _ isint = IsInt : int isint
let is_integer : type a. a typ -> a isint option = fun a ->
match a with
| Integer -> Some IsInt
| _ -> None
type _ isbool = IsBool : bool isbool
let is_boolean : type a. a typ -> a isbool option = fun a ->
match a with
| Boolean -> Some IsBool
| _ -> None
type _ context =
| CEmpty : unit context
| CVar : 'a context * 't typ -> ('a*'t) context
type exp =
| Add of exp*exp
| And of exp*exp
| App of exp*exp
| Lam : 'a typ * exp -> exp
| Var0
| VarS of exp
| Int of int
| Bol of bool
type _ exists_texp =
| Exists : ('gamma,'t) texp * 't typ -> 'gamma exists_texp
let rec typecheck
: type gamma t. gamma context -> exp -> gamma exists_texp =
fun ctx e ->
match e with
| Int i -> Exists ((TInt i) , Integer)
| Bol b -> Exists ((TBol b) , Boolean)
| Var0 ->
begin match ctx with
| CEmpty -> failwith "Tried to grab a nonexistent variable"
| CVar(ctx,t) -> Exists (TVar0 , t)
end
| VarS e ->
begin match ctx with
| CEmpty -> failwith "Tried to grab a nonexistent variable"
| CVar(ctx,_) ->
let tet = typecheck ctx e in
begin match tet with
| Exists (te,t) -> Exists ((TVarS te) , t)
end
end
| Lam(t1,e) ->
let tet2 = typecheck (CVar (ctx,t1)) e in
begin match tet2 with
| Exists (te,t2) -> Exists ((TLam te) , (Arrow(t1,t2)))
end
| App(e1,e2) ->
let te1t1 = typecheck ctx e1 in
let te2t2 = typecheck ctx e2 in
begin match te1t1,te2t2 with
| Exists (te1,t1),Exists (te2,t2) ->
begin match t1 with
| Arrow(t11,t12) ->
let p = is_equal t11 t2 in
begin match p with
| Some IsEqual ->
Exists ((TApp (te1,te2)) , t12)
| None ->
failwith "Mismatch of types on a function application"
end
| _ -> failwith "Tried to apply a non-arrow type"
end
end
| Add(e1,e2) ->
let te1t1 = typecheck ctx e1 in
let te2t2 = typecheck ctx e2 in
begin match te1t1,te2t2 with
| Exists (te1,t1),Exists (te2,t2) ->
let p = is_equal t1 t2 in
let q = is_integer t1 in
begin match p,q with
| Some IsEqual, Some IsInt ->
Exists ((TAdd (te1,te2)) , t1)
| _ ->
failwith "Tried to add with something other than Integers"
end
end
| And(e1,e2) ->
let te1t1 = typecheck ctx e1 in
let te2t2 = typecheck ctx e2 in
begin match te1t1,te2t2 with
| Exists (te1,t1),Exists (te2,t2) ->
let p = is_equal t1 t2 in
let q = is_boolean t1 in
begin match p,q with
| Some IsEqual, Some IsBool ->
Exists ((TAnd (te1,te2)) , t1)
| _ ->
failwith "Tried to and with something other than Booleans"
end
end
let e1 = Add(Int 1,Add(Int 2,Int 3))
let e2 = Add(Int 1,Add(Int 2,Bol false))
let e3 = App(Lam(Integer,Add(Var0,Var0)),Int 4)
let e4 = App(App(Lam(Integer,Lam(Integer,Add(Var0,VarS(Var0)))),Int 4),Int 5)
let e5 = Lam(Integer,Lam(Integer,VarS(Var0)))
let e6 = App(Lam(Integer,Var0),Int 1)
let e7 = App(Lam(Integer,Lam(Integer,Var0)),Int 1)
let e8 = Lam(Integer,Var0)
let e9 = Lam(Integer,Lam(Integer,Var0))
let tet1 = typecheck CEmpty e1
(*let tet2 = typecheck CEmpty e2*)
let tet3 = typecheck CEmpty e3
let tet4 = typecheck CEmpty e4
let tet5 = typecheck CEmpty e5
let tet6 = typecheck CEmpty e6
let tet7 = typecheck CEmpty e7
let tet8 = typecheck CEmpty e8
let tet9 = typecheck CEmpty e9
let rec eval : type gamma t. gamma -> (gamma,t) texp -> t = fun env e ->
match e with
| TAdd (e1,e2) ->
let v1 = eval env e1 in
let v2 = eval env e2 in
v1 + v2
| TAnd (e1,e2) ->
let v1 = eval env e1 in
let v2 = eval env e2 in
v1 && v2
| TApp (e1,e2) ->
let v1 = eval env e1 in
let v2 = eval env e2 in
v1 v2
| TLam e ->
fun x -> eval (env,x) e
| TVar0 ->
let (env,x)=env in
x
| TVarS e ->
let (env,x)=env in
eval env e
| TInt i -> i
| TBol b -> b
type exists_v =
| ExistsV : 't -> exists_v
let typecheck_eval e =
let tet = typecheck CEmpty e in
match tet with
| Exists (te,t) -> ExistsV (eval () te)
let v1 = typecheck_eval e1
let v3 = typecheck_eval e3
let v4 = typecheck_eval e4
let v5 = typecheck_eval e5
let v6 = typecheck_eval e6
let v7 = typecheck_eval e7
let v8 = typecheck_eval e8
let v9 = typecheck_eval e9
Here are the pieces I had trouble with and how I managed to resolve them
In order to correctly type the typed expressions texp, the type of the environment needed to be built into the type of texp. This implies, as gasche correctly noted, that we needed some sort of De Bruijin notation. The easiest was just Var0 and VarS. In order to use variable names, we'd just have to preprocess the AST.
The type of the expression, typ, needed to include both variant types to match on as well as the type we use in the typed expression. In other words, that also needed to be a GADT.
We require three proofs in order to ferret out the correct types in the type checker. These are is_equal, is_integer, and is_bool. The code for is_equal is actually in the OCaml manual under Advanced examples. Specifically, look at the definition of eq_type.
The type exp, for the untyped AST, actually needs to be a GADT also. The lambda abstraction needs access to typ, which is a GADT.
The type checker returns an existential type of both a typed expression as well as the type. We need both to get the program to check type. Also, we need the existential because the untyped expression may or may not have a type.
The existential type, exists_texp, exposes the type of the environment/context, but not the type. We need this type exposed in order to type check properly.
Once everything is setup, the evaluator follows the type rules exactly.
The result of combining the type checker with the evaluator must be another existential type. A priori, we don't know the resulting type, so we have to hide it in an existential package.