Skip to content

Instantly share code, notes, and snippets.

@pqnelson
Created September 11, 2023 17:58
Show Gist options
  • Save pqnelson/4ff12e27d822766bc0a9a9372a0ca166 to your computer and use it in GitHub Desktop.
Save pqnelson/4ff12e27d822766bc0a9a9372a0ca166 to your computer and use it in GitHub Desktop.
IO Monad implemented in SML using Structures
signature MONAD = sig
type 'a m;
val return : 'a -> 'a m;
val bind : 'a m -> ('a -> 'b m) -> 'b m;
end;
signature IO_MONAD = sig
include MONAD;
val exec : 'a m -> 'a;
val getStr : int -> TextIO.vector m;
val putStr : string -> unit m;
end;
(* Mock approximations of "State# RealWorld". *)
type 'a State' = unit;
type RealWorld = unit;
structure IO :> IO_MONAD = struct
datatype 'a m = IO of RealWorld State' -> RealWorld State' * 'a;
(* exec : 'a IO.m -> 'a *)
fun exec (IO f) = let val (_, a) = f () in a end;
(* return : 'a -> 'a IO.m *)
fun return x = IO (fn s => (s, x))
(* (>>=) : 'a IO.m * ('a -> 'b IO.m) -> 'b IO.m *)
local fun unIO (IO a) = a
in fun bind (IO m : 'a m) (k : 'a -> 'b m)
= IO (fn s => case m s of
(new_s, a) => (unIO (k a)) new_s)
end
(* getStr : int -> TextIO.vector IO.m *)
fun getStr n = IO (fn s => (s, TextIO.inputN(TextIO.stdIn, n)))
(* putStr : string -> unit IO.m *)
fun putStr str = IO (fn s => (s, print str))
end;
infix 1 >>=
fun a >>= b = IO.bind a b;
infix 1 >>
fun a >> b = IO.bind a (fn _ => b);
fun gettingLine s : string IO.m =
(IO.getStr 1) >>= (fn c => if c = "\n"
then IO.return s
else gettingLine (s^c));
(* getLine : string IO.m *)
val getLine = gettingLine "";
val main : unit IO.m
= IO.putStr "First name: " >> getLine >>= (fn first =>
IO.putStr "Second name: " >> getLine >>= (fn second =>
IO.putStr ("Hello "^first^" "^second^"\n")));
(* IO.exec main; *)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment