let fun lastcons l =
match l with
cases `Cons (hd, rest) =>
(match rest with
cases (more as `Cons _) => lastcons more
| `Nil () => `Cons (hd, `Nil ()))
fun inclast l =
match lastcons l with
cases `Cons (hd, tl) =>
(match tl with cases `Nil () => hd+1)
in
0
end
let fun print l = String.output (String.concat l)
fun pi what i = print [what, ": ", String.fromInt i, "\n"]
fun test1 () =
let fun addab r =
let val x = r.a + r.b
in pi "addab" x;
x
end
in addab { a = 5, b = 7, c = "hello" } -
addab { b = 23, a = 0 } *
addab { z = 1, a = 22, y = 15, b = -1, x = 4 }
end
fun test2 () =
let fun augmentc (r, x) = { ... = r, c = x }
in (augmentc ({ a = 1 }, 8), augmentc ({ b = 2 }, "a string"))
end
in pi "test1" (test1 ());
let val ({ a, c = c1 }, { b, c = c2 }) = test2 ()
in pi "a" a;
pi "c1" c1;
pi "b" b;
print ["c2: ", c2, "\n"]
end;
0
end
let val n = { i := 1000 }
fun withfresh f = let val i = n!i in n!i := i+1; f i end
(* ---- utilities ---- *)
fun Let (x, e1, e2) = `App (`Lam ([x], e2), [e1])
fun kv2kb kv = fn v => `App (kv, [v])
fun kb2kv kb = withfresh (fn rx => `Lam ([rx], kb (`Var rx)))
fun cvt_app (cvt, e, el, kv) =
let fun lc (el, kb) =
case el of [] => kb []
| e :: el => pc (e, el, fn (v, vl) => kb (v :: vl))
and pc (e, el, kb) = cvt (e, fn v => lc (el, fn vl => kb (v, vl)))
in pc (e, el, fn (v, vl) => `App (v, kv :: vl))
end
fun cvt_lam (cvt, xl, e) =
withfresh (fn xk => `Lam (xk :: xl, cvt (e, kv2kb (`Var xk))))
fun cvt_c (cvt, kb) =
cases `Const i => kb (`Const i)
| `Var x => kb (`Var x)
| `Lam (xl, e) => kb (cvt_lam (cvt, xl, e))
| `App (e, el) => cvt_app (cvt, e, el, kb2kv kb)
fun mkConvert (c, e) =
let fun cvt (e, kb) = match e with c (cvt, kb)
in cvt_lam (cvt, [], e)
end
fun convert e = mkConvert (cvt_c, e)
fun cvt_if_c other (cvt, kb) =
cases `If (e1, e2, e3) =>
withfresh (fn xk =>
Let (xk, kb2kv kb, cvt (e1, fn v1 =>
let val kb' = kv2kb (`Var xk)
in `If (v1, cvt (e2, kb'), cvt (e3, kb'))
end)))
default: other (cvt, kb)
fun cvt_lcc_c other (cvt, kb) =
cases `LetCC (x, e) => (*...*)233
default: other (cvt, kb)
fun convert_if e = mkConvert (cvt_if_c cvt_c, e)
in 0
end
let (* library *)
fun s2i x = String.toInt x
fun i2s x = String.fromInt x
fun print x = String.output (i2s x)
fun println x = (String.output (i2s x); String.output ("\n"))
fun assert (id, x, y) =
if x == y
then (String.output "#"; print id; String.output " is right."; String.output "\n")
else (String.output "#"; print id; String.output " is wrong."; String.output "\n")
(* test cases *)
fun run () = (
(* basic *)
assert (1,
let fun f x = let val {x=a, y=b, ...=c} = x in a end
in f {x=1, y=true, z=[]} end, 1);
assert (2,
let fun f x = let val {x=a, ...=c} = x in c end
fun f' x = x.y
in f' (f {x=true, y=5, z=[]} ) end, 5);
assert (3,
let fun f x = let val {x=a, ...=c} = x in a end
fun g _ = f {x=1, y=true, z=[]}
fun g' _ = f {x=true, z=[]}
in g () end, 1);
assert (4,
let fun f x = let val {x=a, y=b, ...=c} = x in a end
fun g _ = f {x=1, y=true, z=[]}
fun g' _ = f {x=true, y=[], z=[]}
in g () end, 1);
assert (5,
let fun f x = let val {x=a, ...=c} = x in a end
fun g _ = f {x=1, y=true}
in g () end, 1);
assert (6,
let fun f x = let val {x=a, ...=c} = x in c end (* SEL (r,1,3) *)
fun g x = let val {y=a, ...=c} = f x in a end (* SEL (r,1,2) *)
in g {x=true, y=5, z=[]} end, 5);
assert (7,
let fun g x = let val {y=a, ...=c} = {y=x.y, z=x.z} in a end
in g {x=true, y=5, z=[]} end, 5);
assert (8,
let fun f x = let val {...=c} = x in c end (* SEL (r,0,3) *)
fun g x = let val {x=_, y=a, ...=c} = f x in a end (* SEL (r,2,3) *)
in g {x=true, y=5, z=[]} end, 5);
assert (9,
let fun f x = let val {x=a, ...=c} = x in c end
fun g _ = let val {y=a, ...=c} =
f {x=true, y=5, z=[]} in a end
in g() end, 5);
assert (10,
let fun f {x=a, ...=c} = c (* SEL (r,1,3) *)
fun g x = let val {y=a, ...=c} = f x in a end (* SEL (r,1,2) *)
in g {x=true, y=5, z=[]} end, 5)
)
in (run (); 0)
end
let fun i2s x = String.fromInt x
fun print x = String.output (i2s x)
fun assert (id, x, y) =
if x == y
then (String.output "#"; print id; String.output " is right."; String.output "\n")
else (String.output "#"; print id; String.output " is wrong."; String.output "\n")
fun f {x=a, ...=c} = c (* SEL (r,1,3) *)
fun g x = let val {y=a, ...=c} = f x in a end (* SEL (r,1,2) *)
in (assert (1, g {x=true, y=5, z=[]}, 5);0)
end
(***********************************)
(* where exp *)
(***********************************)
let fun i2s x = String.fromInt x
fun print x = String.output (i2s x)
fun assert (id, x, y) =
if x == y
then (String.output "#"; print id; String.output " is right."; String.output "\n")
else (String.output "#"; print id; String.output " is wrong."; String.output "\n")
fun f {x=a, ...=r} = {...=a, b=r.y}
fun f' r = r.b
in (assert (1, f' (f {x={a=1, c=3}, y=5}), 5); 0)
end
TBC...