Added a test and fixed two inference bugs
This commit is contained in:
parent
8f45228e1d
commit
88994419e3
@ -109,14 +109,13 @@ module Make(T : Utils.Functor) = struct
|
|||||||
(Env.find_opt x env)
|
(Env.find_opt x env)
|
||||||
)
|
)
|
||||||
| Untyped.App (t, u) ->
|
| Untyped.App (t, u) ->
|
||||||
let a,b,tau = Var.fresh "a", Var.fresh "b", Var.fresh "τ" in
|
let a,tau = Var.fresh "a", Var.fresh "τ" in
|
||||||
Exist(a,None,
|
Exist(a,None,
|
||||||
Exist(b,None,
|
Exist(tau,Some (Arrow(a,w)),
|
||||||
Exist(tau,Some (Arrow(a,b)),
|
|
||||||
Map(
|
Map(
|
||||||
Conj(has_type env t tau,has_type env u a),
|
Conj(has_type env t tau,has_type env u a),
|
||||||
fun (tt,uu) -> App(tt,uu)
|
fun (tt,uu) -> App(tt,uu)
|
||||||
))))
|
)))
|
||||||
| Untyped.Abs (x, t) ->
|
| Untyped.Abs (x, t) ->
|
||||||
let tau,a,b = Var.fresh "τ",Var.fresh "α", Var.fresh "β" in
|
let tau,a,b = Var.fresh "τ",Var.fresh "α", Var.fresh "β" in
|
||||||
let newenv = Env.add x a env in
|
let newenv = Env.add x a env in
|
||||||
@ -152,7 +151,7 @@ module Make(T : Utils.Functor) = struct
|
|||||||
))
|
))
|
||||||
| Untyped.Annot (t, ty) ->
|
| Untyped.Annot (t, ty) ->
|
||||||
Map(
|
Map(
|
||||||
bind ty (fun w -> has_type env t w),
|
bind ty (fun ww -> Map(Conj(eq w ww,has_type env t ww),snd)),
|
||||||
fun tt -> STLC.Annot(tt,ty)
|
fun tt -> STLC.Annot(tt,ty)
|
||||||
)
|
)
|
||||||
| Untyped.Tuple ts ->
|
| Untyped.Tuple ts ->
|
||||||
|
|||||||
@ -46,7 +46,11 @@ let map f = function
|
|||||||
| Prod ts -> Prod (List.map f ts)
|
| Prod ts -> Prod (List.map f ts)
|
||||||
|
|
||||||
let merge f s1 s2 =
|
let merge f s1 s2 =
|
||||||
Utils.not_yet "Structure.merge" (f, s1, s2)
|
match (s1,s2) with
|
||||||
|
| Var(x),Var(y) -> if x=y then Some(Var(x)) else None
|
||||||
|
| Arrow(s,t),Arrow(u,v) -> Some(Arrow(f s u, f t v))
|
||||||
|
| Prod(t),Prod(u) -> Some(Prod(List.map2 f t u))
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
let global_tyvar : string -> TyVar.t =
|
let global_tyvar : string -> TyVar.t =
|
||||||
(* There are no binders for type variables, which are scoped
|
(* There are no binders for type variables, which are scoped
|
||||||
|
|||||||
1
tests.t/trifun.test
Normal file
1
tests.t/trifun.test
Normal file
@ -0,0 +1 @@
|
|||||||
|
lambda f. lambda x. lambda y. f x y
|
||||||
Loading…
x
Reference in New Issue
Block a user