blog/posts/2022-09-16-ats.md

title	date	tags	show-toc
a little ats program	2022-09-16	computer ATS cool languages	true

full code

```ats #include "share/atspre_define.hats" #include "share/atspre_staload.hats"

datatype typ(int) = | Base(1) | {h1, h2 : nat} Arr(1 + max(h1, h2)) of (typ(h1), typ(h2))

typedef typ = [h : nat] typ(h)

fun eq_typ {ha : nat} .. (a : typ(ha), b : typ) :<> bool = case (a, b) of | (Base(), Base()) => true | (Arr(a1, a2), Arr(b1, b2)) => eq_typ(a1, b1) && eq_typ(a2, b2) | (_, _) => false overload = with eq_typ

fun print_typ (parens : bool, t : typ) : void = case t of | Base() => print "•" | Arr(a, b) => begin if parens then print("("); print_typ(true, a); print(" → "); print_typ(false, b); if parens then print(")"); end

fn print_typ (t : typ) : void = print_typ(false, t) overload print with print_typ

datatype term(int, int) = | {n, i : nat | i < n} Var(n, 1) of int(i) | {n, h : nat} Lam(n, 1 + h) of (typ, term(1 + n, h)) | {n, h1, h2 : nat} App(n, 1 + max(h1, h2)) of (term(n, h1), term(n, h2))

typedef term(n : int) = [h : nat] term(n, h)

typedef ctx(n: int) = list(typ, n)

fun lookup {n, i : nat | i < n} .. (g : ctx(n), i : int(i)) :<> typ = let val+ list_cons(x, g) = g in if i = 0 then x else lookup(g, i - 1) end

datatype result(t@ype, t@ype) = | {a, e : t@ype} Ok(a, e) of a | {a, e : t@ype} Err(a, e) of e

datatype err = | Clash of (typ, typ) | NotArr of typ

fn print_err (e : err) : void = case e of | Clash(a, b) => begin print("clash between types ["); print(a); print("] and ["); print(b); print("]"); end | NotArr(t) => begin print("expected an arrow type, but got ["); print(t); print("]"); end overload print with print_err

typedef typ_res = result(typ, err)

fn print_res (r : typ_res) : void = case r of Ok(t) => print(t) | Err(e) => print(e) overload print with print_res

fn typ_of {n : nat} (g : ctx n, t : term(n)) :<> typ_res = let exception ERR of err fun go {n, h : nat} .. (g : ctx(n), t : term(n, h)) :<!exn> typ = case t of | Var(i) => lookup(g, i) | Lam(a, t) => Arr(a, go(list_cons(a, g), t)) | App(s, t) => begin case go(g, s) of | Arr(a1, b) => let val a2 = go(g, t) in if a1 = a2 then b else $raise ERR(Clash(a1, a2)) end | b => $raise ERR(NotArr(b)) end in $effmask_exn(try Ok(go(g, t)) with ~ERR(e) => Err(e)) end

fn typ_of (t : term(0)) :<> typ_res = typ_of(list_nil, t)

implement main0() = begin print("type of [λx:•. x] is: "); print(typ_of(Lam(Base, Var(0)))); print("\ntype of [λx:•. x x] is: "); print(typ_of(Lam(Base, App(Var(0), Var(0))))); print("\n") end

</details>