Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #include "share/atspre_staload.hats"
- vtypedef llist(a:vt@ype) = List_vt(a)
- extern fun{fa,a0:vt0p}{fb,b0:vt0p}
- monad_bind: (!fa) -> fb
- extern fun{a0:vt0p}{fb,b0:vt0p}
- monad_bind$f: (!a0) -> fb
- extern fun{fa,a0:vt0p}{fb,b0:vt0p}
- monad_fmap: (!fa) -> fb
- extern fun{a0:vt0p}{b0:vt0p}
- monad_fmap$f: (!a0) -> b0
- extern fun{fa,a0:vt0p}{fb,b0:vt0p}
- monad_bind_free: fa -> fb
- extern fun{a0:vt0p}{fb,b0:vt0p}
- monad_bind_free$f: a0 -> fb
- extern fun{fa,a0:vt0p}{fb,b0:vt0p}
- monad_fmap_free: (fa) -> fb
- extern fun{a0:vt0p}{b0:vt0p}
- monad_fmap_free$f: a0 -> b0
- extern fun{fa,a0:vt0p}
- monad_return(x0: a0): fa
- implement(a:vt@ype)
- monad_return<llist(a),a>(x0) = list_vt_sing(x0)
- implement(a:vt@ype)
- monad_return<llist(a),a>(x0) = list_vt_sing(x0)
- implement(a,b:t@ype)
- monad_bind<llist(a),a><llist(b),b>(fx) =
- list_vt_concat<b>(list_vt_map<a><llist(b)>(fx)) where
- implement
- list_vt_map$fopr<a><llist(b)>(x) =
- monad_bind$f<a><llist(b),b>(x)
- end
- implement{fa,a0}{fb,b0}
- monad_fmap(fx) =
- (
- monad_bind<fa,a0><fb,b0>(fx) where
- implement
- monad_bind$f<a0><fb,b0>(x0) =
- (monad_return<fb,b0>(monad_fmap$f<a0><b0>(x0)))
- end
- )
- implement(a,b:t@ype)
- monad_bind_free<llist(a),a><llist(b),b>(fx) =
- list_vt_concat<b>(list_vt_mapfree<a><llist(b)>(fx)) where
- implement
- list_vt_mapfree$fopr<a><llist(b)>(x) =
- monad_bind_free$f<a><llist(b),b>(x)
- end
- implement{fa,a0}{fb,b0}
- monad_fmap_free(fx) =
- (
- monad_bind_free<fa,a0><fb,b0>(fx) where
- implement
- monad_bind_free$f<a0><fb,b0>(x0) =
- (monad_return<fb,b0>(monad_fmap_free$f<a0><b0>(x0)))
- end
- )
- local
- implement fprint_list_vt$sep<>(out) = ()
- in
- fun test_free(): void =
- {
- val xs = $list_vt{int}(70,114,101,101,100)
- val ys = monad_fmap_free<llist(int),int><llist(char),char>(xs) where
- implement
- monad_fmap_free$f<int><char>(x) = int2char0(x)
- end
- val () = println!(ys) where
- implement fprint_list_vt$sep<>(out) = ()
- end
- val () = list_vt_free(ys)
- }
- fun test_preserve(): void =
- {
- val xs = $list_vt{int}(80,114,101,115,101,114,118,101,100)
- val ys = monad_fmap<llist(int),int><llist(char),char>(xs) where
- implement
- monad_fmap$f<int><char>(x) = int2char0(x)
- end
- val () = println!(ys)
- // notice: xs was preserved so we need to free it...
- val () = list_vt_free(xs)
- val () = list_vt_free(ys)
- }
- end
- implement main0() = (test_free(); test_preserve())
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement