Monads/Writer monad: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
|||
Line 187: | Line 187: | ||
divided by two -> 1.61803398875" |
divided by two -> 1.61803398875" |
||
}</pre> |
}</pre> |
||
=={{header|ATS}}== |
|||
The entry for [[#Haskell|Haskell]] inspired me to do such things as add a <code>>=></code> operator, and to use <code>return</code> as a name for the ''unit'' operation. But notice that I write <code>return<double></code>. The template system, for whatever reason, could not infer the type, if I left out the template parameter. It did not signal an error, but instead produced C code that could not be compiled. This kind of behavior is common with the Postiats implementation of ATS, and must be gotten used to. |
|||
(''Footnote'': Sometimes the template system will produce C code that ''can'' be compiled but does not function correctly! No doubt the template system can be made more shipshape, but it is what it is. In any case, one then goes through the code and fills in elided template parameters, until the code works.) |
|||
<syntaxhighlight lang="ats"> |
|||
#include "share/atspre_staload.hats" |
|||
%{^ |
|||
#include <math.h> |
|||
%} |
|||
#define NIL list_nil () |
|||
#define :: list_cons |
|||
(* The log is a list of strings. For efficiency, it is ordered |
|||
most-recent-first. The static value "n" represents the number of |
|||
entries in the log. (It exists and is used only during the |
|||
typechecking phase.) *) |
|||
datatype Writer (a : t@ype+, n : int) = |
|||
| Writer of (a, list (string, n)) |
|||
typedef Writer (a : t@ype+) = [n : int] Writer (a, n) |
|||
prfn |
|||
lemma_Writer_param {a : t@ype} |
|||
{n : int} |
|||
(m : Writer (a, n)) |
|||
:<prf> [0 <= n] void = |
|||
let |
|||
val+ Writer (_, log) = m |
|||
in |
|||
lemma_list_param log |
|||
end |
|||
fn {a : t@ype} |
|||
unit_Writer (x : a) : Writer (a, 1) = |
|||
let |
|||
val msg = string_append ("unit_Writer (", |
|||
tostring_val<a> x, ")") |
|||
val msg = strptr2string msg |
|||
in |
|||
Writer (x, msg :: NIL) |
|||
end |
|||
overload return with unit_Writer |
|||
fn {a, b : t@ype} |
|||
bind_Writer {n : int} |
|||
(m : Writer (a, n), |
|||
f : a -<cloref1> Writer b) |
|||
: [n1 : int | n <= n1] Writer (b, n1) = |
|||
let |
|||
val+ Writer (x, log) = m |
|||
val y = f (x) |
|||
prval () = lemma_Writer_param y |
|||
val+ Writer (y, entries) = y |
|||
in |
|||
Writer (y, list_append (entries, log)) |
|||
end |
|||
infixl 0 >>= |
|||
overload >>= with bind_Writer |
|||
fn {a, b, c : t@ype} |
|||
compose_Writer (f : a -<cloref1> Writer b, |
|||
g : b -<cloref1> Writer c) |
|||
: a -<cloref1> Writer c = |
|||
lam m => f m >>= g |
|||
infixl 0 >=> |
|||
overload >=> with compose_Writer |
|||
(* "make_Writer_closure_from_fun" wraps an ordinary function from a to |
|||
b, resulting in a closure that will produce exactly one log |
|||
entry. *) |
|||
fn {a, b : t@ype} |
|||
make_Writer_closure_from_fun (func : a -> b, |
|||
make_msg : (a, b) -<cloref1> string) |
|||
: a -<cloref1> Writer (b, 1) = |
|||
lam x => |
|||
let |
|||
val y = func x |
|||
in |
|||
Writer (y, make_msg (x, y) :: NIL) |
|||
end |
|||
overload make_Writer_closure with make_Writer_closure_from_fun |
|||
(* A note regarding "root": interfaces to the C math library are |
|||
available, even within the Postiats distribution, but I shall |
|||
simply make a foreign function call to sqrt(3). The Postiats |
|||
prelude itself provides no (or very little) interface to libm. *) |
|||
fn root (x : double) : double = $extfcall (double, "sqrt", x) |
|||
fn addOne (x : double) : double = succ x |
|||
fn half (x : double) : double = 0.5 * x |
|||
fn {a, b : t@ype} |
|||
make_logging (func : a -> b, |
|||
notation : string) |
|||
: a -<cloref1> Writer (b, 1) = |
|||
let |
|||
fn |
|||
make_msg (x : a, y : b) :<cloref1> string = |
|||
let |
|||
val msg = string_append ("(", tostring_val<a> x, |
|||
" |> ", notation, ") --> ", |
|||
tostring_val<b> y) |
|||
in |
|||
strptr2string msg |
|||
end |
|||
in |
|||
make_Writer_closure<a,b> (func, make_msg) |
|||
end |
|||
val logging_root = make_logging<double,double> (root, "sqrt") |
|||
val logging_addOne = make_logging<double,double> (addOne, "(+ 1.0)") |
|||
val logging_half = make_logging<double,double> (half, "(0.5 *)") |
|||
val the_big_whatchamacallit = |
|||
logging_root >=> logging_addOne >=> logging_half |
|||
fn |
|||
print_log (log : List string) : void = |
|||
let |
|||
fun |
|||
loop (lst : List0 string) : void = |
|||
case+ lst of |
|||
| NIL => () |
|||
| hd :: tl => |
|||
begin |
|||
println! (" ", hd); |
|||
loop tl |
|||
end |
|||
prval () = lemma_list_param log |
|||
in |
|||
loop (list_vt2t (list_reverse log)) |
|||
end |
|||
implement |
|||
main0 () = |
|||
let |
|||
val x = 5.0 |
|||
val m = return<double> x |
|||
val+ Writer (y, log) = m >>= the_big_whatchamacallit |
|||
in |
|||
println! ("(1 + sqrt(", x : double, "))/2 = ", y : double); |
|||
println! ("log:"); |
|||
print_log log |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>$ patscc -std=gnu2x -g -O2 -DATS_MEMALLOC_GCBDW writer_monad_ats.dats -lgc -lm && ./a.out |
|||
(1 + sqrt(5.000000))/2 = 1.618034 |
|||
log: |
|||
unit_Writer (5.000000) |
|||
(5.000000 |> sqrt) --> 2.236068 |
|||
(2.236068 |> (+ 1.0)) --> 3.236068 |
|||
(3.236068 |> (0.5 *)) --> 1.618034</pre> |
|||
=={{header|C++}}== |
=={{header|C++}}== |