COMMENT:-----------------------

ghc -c -O CPS.lhs
-------------------------------


> module CPS            (  CPS,
>                       -- Continuation-passing-style Monad
>                          unit, (&=), (&), (&@), abort,
>                          sequenc, accumulat,
>                       -- State transformer
>                       -- Backtracking
>                          BT,
>                          zzero, hardFail, (??), alternate, cut, (?),
>                          guard, (|>), opt,
>                          many, many1, sepByCPS, sepBy1CPS,
>                          lookAhead,
>                          firstSolution, allSolutions
>                       )
> where




> infixr 2 &=, &        -- infix operators for `thenCPS` and `sequCPS`
> infixr 2 &@           -- infix operator for `mapCPS`
> infixr 1 ??, ?        -- choice and biased choice
> infixr 3 |>           -- infix operator for `filter`



Continuation-passing-style Monad
CPS for short.


> type CPS val res      =  (val -> res) -> res


res stands for result, alternative names include answer and output. unit returns the given value.


> unit                  :: val -> CPS val res
> unit v                =  \c -> c v


&= sequences two actions.


> (&=)                  :: CPS val1 res -> (val1 -> CPS val2 res)
>                       -> CPS val2 res
> m &= k                =  \c -> m (\v -> k v c)


& sequences two actions ignoring the value produced by the first action.


> (&)                   :: CPS val1 res -> CPS val2 res -> CPS val2 res
> p1 & p2               =  p1 &= \_ -> p2


&@ applies a function to the result of an action.


> (&@)                  :: CPS val1 res -> (val1 -> val2) -> CPS val2 res
> m &@ f                =  m &= \v -> unit (f v)


abort aborts with the given value (hard failure).


> abort                 :: res -> CPS val res
> abort r               =  \c -> r


Sequencing and accumulating (besser: auch so nennen!!)


> sequenc               :: [CPS val res] -> CPS () res
> sequenc               =  foldr (&) (unit ())




> accumulat             :: [CPS val res] -> CPS [val] res
> accumulat             =  foldr cons (unit [])
>     where m `cons` n  =  m &= \v -> n &= \vs -> unit (v:vs)


Possible applications.
State transformer:

CPS val (st -> res)
CPS with choice:

CPS val (res -> res)
CPS with choice and a backtrackable state:

CPS val (res -> st -> res)
CPS based on the IO Monad:

CPS val (IO res)

State transformer
ToDo.

Name supply
ToDo.

Backtracking
CPS Monad with failure continuation and a backtrackable state.


> type BT st val res    =  CPS val (res -> st -> res)


hardFail aborts with the given value (hard failure).


> hardFail              :: res -> BT st val res
> hardFail r            =  abort (\f s -> r)


zzero fails (soft failure).


> zzero                  :: BT st val res
> zzero                  =  \c f s -> f


Choice (note that the state is duplicated).


> (??)                  :: BT st val res -> BT st val res -> BT st val res
> m ?? n                =  \c f s -> m c (n c f s) s




> alternate             :: [BT st val res] -> BT st val res
> alternate             =  foldr (??) zzero


cut discards the choice points of its argument.


> cut                   :: BT st val res -> BT st val res
> cut m                 =  \c f s -> m (\v _ -> c v f) f s


Biased choice (choice points of the first branch are discarded).


> (?)                   :: BT st val res -> BT st val res -> BT st val res
> m ? n                 =  cut m ?? n


Guards, filters and optional actions.


> guard                 :: Bool -> BT st () res
> guard b               =  if b then unit () else zzero




> assert                :: Bool -> res -> BT st () res
> assert b r            =  if b then unit () else hardFail r




> (|>)                  :: BT st val res -> (val -> Bool) -> BT st val res
> m |> p                =  m &= \v -> guard (p v) & unit v




> opt                   :: BT st val res -> val -> BT st val res
> opt m a               =  m ? unit a


Repetition.


> many, many1           :: BT st val res -> BT st [val] res
> many m                =  (m &= \a -> many m &= \x -> unit (a:x))
>                       ?  unit []
> many1 m               =  m &= \a -> many m &= \x -> unit (a:x)




> sepByCPS, sepBy1CPS         :: BT st val1 res -> BT st val2 res -> BT st [val1] res
> sepByCPS m s             =  sepBy1CPS m s ? unit []
> sepBy1CPS m s            =  m &= \a -> many (s & m) &= \x -> unit (a:x)


Lookahead (runs m without changing the state).


> lookAhead m           =  \c f s -> m (\v f _ -> c v f s) f s


First solution.


> firstSolution         :: BT st val (Maybe val) -> st -> Maybe val
> firstSolution p       =  p (\a _ _ -> Just a) Nothing


All solutions.


> allSolutions          :: BT st val [val] -> st -> [val]
> allSolutions p        =  p (\a f _ -> a : f) []


Optimizations (ghc only).


> {-# INLINE unit     #-}
> {-# INLINE (&=)     #-}
> {-# INLINE (&)      #-}
> {-# INLINE (&@)     #-}
> {-# INLINE abort    #-}
> {-# INLINE zzero    #-}
> {-# INLINE hardFail #-}
> {-# INLINE (??)     #-}
> {-# INLINE cut      #-}
> {-# INLINE (?)      #-}