(* unify.rml *)
module Unify:
  with "types.rml"
  relation unify: (Types.Type, Types.Type) => ()
end

with "util.rml"

relation same_alphas =
  rule	int_eq(tag1, tag2) => flag
	----------------
	same_alphas(Types.ALPHA(tag1,_,_,_,_), Types.ALPHA(tag2,_,_,_,_)) => flag
end

(* OCCUR CHECK *)

relation check_occur =
  rule	Types.deref ty => ty' & ocheck2(alpha, ty')
	----------------
	check_occur(alpha, ty)
end

and ocheck2 =
  rule	same_alphas(alpha, alpha') => false
	----------------
	ocheck2(alpha, Types.VAR alpha')

  rule	ocheck3(alpha, tys)
	----------------
	ocheck2(alpha, Types.CONS(tys,_))
end

and ocheck3 =
  axiom ocheck3(_, [])

  rule	check_occur(alpha, ty) & ocheck3(alpha, tys)
	----------------
	ocheck3(alpha, ty::tys)
end

(* SCOPE LEVEL CHECK *)

relation check_level =
  rule	Types.deref ty => ty' & lcheck2(maxlev, ty')
	----------------
	check_level(maxlev, ty)
end

and lcheck2 =
  rule	int_le(lev, maxlev) => true
	----------------
	lcheck2(maxlev, Types.VAR(Types.ALPHA(_,lev,_,_,_)))

  rule	int_le(lev, maxlev) => false &
	Types.mkAlpha(maxlev,eq,ovld) => alpha &
	lvar_set(subst, Types.VAR alpha)
	----------------
	lcheck2(maxlev, Types.VAR(Types.ALPHA(_,lev,eq,ovld,subst)))

  rule	lcheck3(maxlev, tys)
	----------------
	lcheck2(maxlev, Types.CONS(tys,_))
end

and lcheck3 =
  axiom lcheck3(_, [])

  rule	check_level(maxlev, ty) & lcheck3(maxlev, tys)
	----------------
	lcheck3(maxlev, ty::tys)
end

(* EQUALITY CHECK *)

relation check_equality =
  rule	Types.deref ty => ty' & echeck2 ty'
	----------------
	check_equality ty
end

and echeck2 =
  rule	eq = true
	----------------
	echeck2(Types.VAR(Types.ALPHA(_,_,eq,_,_)))

  rule	not eq = true &
	Types.mkAlpha(lev,true,ovld) => alpha &
	lvar_set(subst, Types.VAR alpha)
	----------------
	echeck2(Types.VAR(Types.ALPHA(_,lev,eq,ovld,subst)))

  rule	name = "ref"
	----------------
	echeck2(Types.CONS(_,name))

  rule	not name = "ref" & not name = "->" & echeck3 tys
	----------------
	echeck2(Types.CONS(tys,name))
end

and echeck3 =
  axiom echeck3 []

  rule	check_equality ty & echeck3 tys
	----------------
	echeck3(ty::tys)
end

relation maybe_check_equality =
  axiom maybe_check_equality(false, _)

  rule	check_equality ty
	----------------
	maybe_check_equality(true, ty)
end

(* OVERLOADING CHECK *)

relation check_ovld =
  axiom	check_ovld(NONE, _)

  rule	list_member(tyname, tynames) => true
	----------------
	check_ovld(SOME tynames, Types.CONS([],tyname))
end

(* UNIFICATION *)

relation bind_alpha =
  rule	check_occur(alpha1, ty2) &
	check_level(lev, ty2) &
	maybe_check_equality(eq, ty2) &
	check_ovld(ovld, ty2) &
	lvar_set(subst, ty2)
	----------------
	bind_alpha(alpha1 as Types.ALPHA(_,lev,eq,ovld,subst), ty2)
end

relation join_ovld =
  axiom	join_ovld(NONE, ovld2) => ovld2
  axiom join_ovld(ovld1 as SOME _, NONE) => ovld1

  rule	Util.intersect(tynames1, tynames2) => tynames3
	----------------
	join_ovld(SOME tynames1, SOME tynames2) => SOME tynames3
end

relation bind_alphas =
  rule	int_min(lev1, lev2) => lev3 &
	bool_or(eq1, eq2) => eq3 &
	join_ovld(ovld1, ovld2) => ovld3 &
	Types.mkAlpha(lev3, eq3, ovld3) => alpha3 &
	let ty3 = Types.VAR alpha3 &
	lvar_set(subst1, ty3) &
	lvar_set(subst2, ty3)
	----------------
	bind_alphas(Types.ALPHA(_,lev1,eq1,ovld1,subst1),
		    Types.ALPHA(_,lev2,eq2,ovld2,subst2))
end

relation unify_alphas =
  rule	same_alphas(alpha1, alpha2) => true
	----------------
	unify_alphas(alpha1, alpha2)

  rule	same_alphas(alpha1, alpha2) => false & bind_alphas(alpha1, alpha2)
	----------------
	unify_alphas(alpha1, alpha2)
end

relation unify =
  rule	Types.deref ty1 => ty1' & Types.deref ty2 => ty2' & unify2(ty1', ty2')
	----------------
	unify(ty1, ty2)
end

and unify2 =
  rule	unify_alphas(alpha1, alpha2)
	----------------
	unify2(Types.VAR alpha1, Types.VAR alpha2)

  rule	bind_alpha(alpha1, ty2)
	----------------
	unify2(Types.VAR alpha1, ty2 as Types.CONS(_,_))

  rule	bind_alpha(alpha2, ty1)
	----------------
	unify2(ty1 as Types.CONS(_,_), Types.VAR alpha2)

  rule	name1 = name2 & unify3(tys1, tys2)
	----------------
	unify2(Types.CONS(tys1,name1), Types.CONS(tys2,name2))
end

and unify3 =
  axiom unify3([], [])

  rule	unify(ty1, ty2) & unify3(tys1, tys2)
	----------------
	unify3(ty1::tys1, ty2::tys2)
end
