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

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

> module CPS            (  CPS(..),
>                       -- Continuation-passing-style Monad
>                          unit, (&=), (&), (&@), abort,
>                          sequenc, accumulat,
>                       -- State transformer
>                       -- Backtracking
>                          BT(..),
>                          zero, hardFail, (??), alternate, cut, (?),
>                          guard, (|>), opt,
>                          many, many1, sepBy, sepBy1,
>                          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)

zero fails (soft failure).

> zero                  :: BT st val res
> zero                  =  \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 (??) zero

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 zero

> 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)

> sepBy, sepBy1         :: BT st val1 res -> BT st val2 res -> BT st [val1] res
> sepBy m s             =  sepBy1 m s ? unit []
> sepBy1 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 zero     #-}
> {-# INLINE hardFail #-}
> {-# INLINE (??)     #-}
> {-# INLINE cut      #-}
> {-# INLINE (?)      #-}