 # Martin Pärtel

a guest
Sep 30th, 2010
276
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. {-# LANGUAGE ExistentialQuantification #-}
2.
3. -- This is taking a stab at mimicking the eff language in Haskell:
4. -- http://math.andrej.com/2010/09/27/programming-with-effects-ii-introducing-eff/
5.
6. -- A definition of an "operation" takes a continuation (y -> r)
7. -- and gives a result a with it.
8. data Def y r a = Def ((y -> r) -> a)
9.
10. -- We make a monadic DSL for defining operations.
11. instance Monad (Def y r) where
12.   -- An operation just returning x can ignore its continuation.
13.   return x = Def (\_ -> x)
14.   -- An operation d followed by a choice of operation b means
15.   -- d gets to look at the continuation k first and must return
16.   -- something that is used to choose the appropriate b,
17.   -- which gets to use the continuation next.
18.   (Def d) >>= b' = Def (\k ->
19.    let (Def b) = b' (d k)
20.     in b k)
21.
22. -- "yield y" is an operation yielding the given value y to the continuation
23. -- and returning the result of the continuation directly.
24. yield :: y -> Def y r r
25. yield y = Def (\k -> k y)
26.
27. -- Our "programs" can call the operations we've defined,
28. -- or they can just return a constant.
29. -- An operation invocation knows the op definition ((y -> r) -> a) and
30. -- knows how to build the continuation program for a yielded value y.
31. data Prog a = forall y r. ProgOp ((y -> r) -> a) (y -> Prog r)
32.              | ProgRet a
33.
34. -- We evaluate a call to an operation by giving the operation
35. -- a continuation that, when yielded y, evaluates the continuation program
36. -- chosen by y.
37. evalProg :: Prog a -> a
38. evalProg (ProgOp f k) = f (\y -> (evalProg (k y)))
39. evalProg (ProgRet x) = x
40.
41. -- Now we define the monadic DSL for defining programs that use the
42. -- operations defined with the above.
44.   return x = ProgRet x
45.   -- To sequence s and a choice of t, we do the following.
46.   -- We define an operation that, given a continuation k goes to evaluate the
47.   -- "first half" s and pass the result y to k.
48.   -- We arrange k to be such that it uses the y to choose t.
49.   s >>= t = ProgOp (\k -> k (evalProg s)) (\y -> t y)
50.
51. -- A program consisting of just a call to an operation will just return the
52. -- result the operation yields it.
53. mkOp :: Def y y a -> Prog a
54. mkOp (Def d) = ProgOp d (\y -> ProgRet y)
55.
56.
57. -- Examples...
58.
59. minChoose :: (Ord a) => a -> a -> Prog a
60. minChoose a b = mkOp \$
61.   do l <- yield a
62.      r <- yield b
63.      return \$ min l r
64.
65. choiceExample =
66.   do x <- choose 3 2
67.      y <- choose 5 10
68.      return \$ x + y
69.   where
70.     choose = minChoose
71.
72. -- yay! ^_^
73.
74. -- Problem: mkOp would force a type equation () = (String, a)
75. -- Well, they said they had problems coming up with a type system..
76. --printToLog :: String -> Prog (String, a)
77. printToLog msg = --mkOp \$
78.   do (log, result) <- yield ()
79.      return (prepend msg log, result)
80.   where
81.     prepend msg "" = msg
82.     prepend msg log = msg ++ ", " ++ log
83.
84. main =
85.   do print \$ evalProg choiceExample