----------------------------------------------------------------------
ADP combinators and functions from:

R. Giegerich, C. Meyer and P. Steffen. Towards a discipline of dynamic
programming.

----------------------------------------------------------------------

> module ADPCombinators where
> import Data.Array

Lexical parsers
----------------

> type Subword  = (Int,Int)
> type Parser b = Subword -> [b]

> empty        :: Parser ()
> empty  (i,j) =  [() | i == j]

> acharSep'           ::  Array Int Char -> Char -> Parser Char
> acharSep' z s (i,j) =  [z!j | i+1 == j, z!j /= s] 

> achar'         :: Array Int a -> Parser a
> achar' z (i,j) = [z!j | i+1 == j]

> char'           ::  Eq a => Array Int a -> a -> Parser a
> char' z c (i,j) =  [c | i+1 == j, z!j == c]

> astring       :: Parser Subword
> astring (i,j) =  [(i,j) | i <= j]

> string'           :: Eq a => Array Int a -> [a] -> Parser Subword
> string' z s (i,j) = [(i,j)| and [z!(i+k) == s!!(k-1) | k <-[1..(j-i)]]]

Parser combinators
-------------------

> infixr 6 ||| 
> (|||)           :: Parser b -> Parser b -> Parser b
> (|||) r q (i,j) = r (i,j) ++ q (i,j)

> infix  8 <<<
> (<<<)           :: (b -> c) -> Parser b -> Parser c
> (<<<) f q (i,j) =  map f (q (i,j))

> infixl 7 ~~~
> (~~~)           :: Parser (b -> c) -> Parser b -> Parser c
> (~~~) r q (i,j) =  [f y | k <- [i..j], f <- r (i,k), y <- q (k,j)]  

> infix  5 ...
> (...)           :: Parser b -> ([b] -> [b]) -> Parser b
> (...) r h (i,j) = h (r (i,j))


> type Filter    =  (Int, Int) -> Bool
> with           :: Parser b -> Filter -> Parser b
> with q c (i,j) =  if c (i,j) then q (i,j)  else []

> axiom'        :: Int -> Parser b -> [b]
> axiom' l ax   =  ax (0,l) 

Tabulation
-----------

> -- two-dimensional tabulation
> table     :: Int -> Parser b -> Parser b
> table n q =  (!) $ array ((0,0),(n,n))
>                    [((i,j),q (i,j)) | i<- [0..n], j<- [i..n]]

> -- one-dimensional tabulation; index j fixed
> listi :: Int -> Parser b -> Parser b
> listi n p = q $ array (0,n) [(i, p (i,n)) | i <- [0..n]] 
>    where
>    q t (i,j) = if j==n then t!i else []

> -- one-dimensional tabulation; index i fixed
> listj :: Int -> Parser b -> Parser b
> listj n p = q $ array (0,n) [(j, p (0,j)) | j <- [0..n]] 
>    where
>    q t (i,j) = if i==0 then t!j else []

> -- the most common listed type is listi (input read from left
> -- to right), so we define a default list here:
> list :: Int -> Parser b -> Parser b
> list = listi

Variants of the <<< and ~~~ Combinators
-------------------------------

> infix  8 ><<
> infixl 7 ~~, ~~*, *~~, *~*
> infixl 7 -~~, ~~-, +~~, ~~+, +~+

The operator ><< is the special case of <<< for a nullary function f

> (><<)           :: c -> Parser b -> Parser c
> (><<) f q (i,j) =  [f|a <- (q (i,j))]

Subwords on left and right of an explicit length range.

> (~~) :: (Int,Int) -> (Int,Int) 
>      -> Parser (b -> c) -> Parser b -> Parser c
> (~~) (l,u) (l',u') r q (i,j) 
>      = [x y | k <- [max (i+l) (j-u') .. min (i+u) (j-l')],
>               x <- r (i,k), y <- q (k,j)]

Subwords of explicit length range and unbounded length on one or on
either side.

> (~~*) :: (Int,Int) -> Int 
>       -> Parser (a -> b) -> Parser a -> Parser b 
> (~~*) (l, u) l' r q (i, j) 
>       = [x y | k <- [(i + l) .. min (i + u) (j - l')], 
>                x <- r (i, k), y <- q (k, j)] 

> (*~~) :: Int -> (Int,Int) 
>       -> Parser (a -> b) -> Parser a -> Parser b 
> (*~~) l (l', u') r q (i, j) 
>       = [x y | k <- [max (i + l) (j - u') .. (j - l')], 
>           x <- r (i, k), y <- q (k, j)] 

> (*~*) :: Int -> Int 
>       -> Parser (a -> b) -> Parser a -> Parser b 
> (*~*) l l' r q (i, j) 
>       = [x y | k <- [(i + l) .. (j - l')], 
>                x <- r (i, k), y <- q (k, j)] 

Single character on the lefthand (respectively righthand) side

> (-~~)           :: Parser (b -> c) -> Parser b -> Parser c
> (-~~) q r (i,j) = [x y | i<j, x <- q (i,i+1), y <- r (i+1,j)]

> (~~-)           :: Parser (b -> c) -> Parser b -> Parser c
> (~~-) q r (i,j) = [x y | i<j, x <- q (i,j-1), y <- r (j-1,j)]

Nonempty sequence on the lefthand (respectively righthand) side

> (+~~)           :: Parser (b -> c) -> Parser b -> Parser c
> (+~~) r q (i,j) =  [f y | k <- [i+1..j], f <- r (i,k), y <- q (k,j)]  

> (~~+)           :: Parser (b -> c) -> Parser b -> Parser c
> (~~+) r q (i,j) =  [f y | k <- [i..j-1], f <- r (i,k), y <- q (k,j)]  

Nonempty sequence on either side

> (+~+)           :: Parser (b -> c) -> Parser b -> Parser c
> (+~+) r q (i,j) = [f y | k <- [(i+1)..(j-1)], f <- r (i,k), y <- q (k,j)]  


Create array from List
-----------------------

> mk :: [a] -> Array Int a
> mk xs = array (1,n) (zip [1..n] xs) where n = length xs
