-- <pre>
import Monad(MonadPlus(..))
import Char(isAlphaNum)

import Array(Array,array,(!),ixmap,elems)

fib :: Integer -> Integer
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

{-
Main> fib 25
121393
(4334712 reductions, 7091332 cells, 30 garbage collections)
takes about 4 seconds on my machine
-}

fix f = f (fix f)

g fib 0 = 1
g fib 1 = 1
g fib n = fib (n-1) + fib (n-2)

fib1 = fix g



fib2 :: Integer -> Integer
fib2 z = f z
  where table = array (0,z) [ (i, f i) | i <- range (0,z) ]
        f 0 = 1
        f 1 = 1
        f n = (table ! (n-1)) + (table ! (n-2))

memo :: Ix a => (a,a) -> ((a -> b) -> a -> b) -> a -> b
memo bounds g = f
  where arrayF = array bounds [ (n, g f n) | n <- range bounds ]
        f x = arrayF ! x

fib3 n = memo (0,n) g n


fact = memo (0,100) g
   where g fact n = if n==0 then 1 else n * fact (n-1)





--===================================================================
-- Between these lines is a parsing library
{---------------------------------------------------------------------

           A GOFER LIBRARY OF MONADIC PARSER COMBINATORS

                         29th November 1996
              (modified by Erik Meijer for use with Gofer)

      Graham Hutton              Erik Meijer          Philip Wadler
 University of Nottingham   University of Utrecht   Bell Laboratories

This Haskell 1.3 library is derived from our article "Monadic Parsing
in Haskell".  The library also includes a few extra combinators that
were not discussed in the article for reasons of space:

   o force (used to make "many" deliver results lazily);

   o digit, lower, upper, letter, alphanum (useful parsers);

   o ident, nat, int (useful token parsers);

   o comment (a parser for single-line Haskell comments).

-- This library was modifed by Tim Sheard to work with Haskell 98 (2/25/2003)

---------------------------------------------------------------------}


infixr 5 +++

-- Monad of parsers: -------------------------------------------------

data Parser a =
  Parser (String -> [(a,String)])

instance Monad Parser where
  return v = Parser (\inp -> [(v,inp)])
  p >>= f =
    Parser (\inp ->
            concat [applyP (f v) out
                   | (v,out) <- applyP p inp])

instance MonadPlus Parser where
  mzero = Parser (\inp -> [])
  mplus (Parser p) (Parser q)
      = Parser(\inp -> p inp ++ q inp)

instance Functor Parser

-- Other parsing primitives: -----------------------------------------

applyP :: Parser a -> String -> [(a,String)]
applyP (Parser p) = p

item :: Parser Char
item =
  Parser (\inp ->
          case inp of
            ""    -> []
            (x:xs) -> [(x,xs)])

sat :: (Char -> Bool) -> Parser Char
sat p = do {x <- item; if (p x) then return x else mzero}

-- Efficiency improving combinators: ---------------------------------

force :: Parser a -> Parser a
force p =
  Parser (\inp ->
          let x = applyP p inp in
            (fst (head x), snd (head x))
            : tail x)

(+++) :: Parser a -> Parser a -> Parser a
p +++ q =
  Parser(\inp ->
         case applyP (p `mplus` q) inp of
           []     -> []
           (x:xs) -> [x])

-- Recursion combinators: --------------------------------------------

string :: String -> Parser String
string ""     = return ""
string (x:xs) = do char x; string xs
                   return (x:xs)

many :: Parser a -> Parser [a]
many p = force (many1 p +++ return [])

many1 :: Parser a -> Parser [a]
many1 p = do x <- p
             xs <- many p
             return (x:xs)

sepby :: Parser a -> Parser b -> Parser [a]
p `sepby` sep = (p `sepby1` sep) +++ return []

sepby1 :: Parser a -> Parser b -> Parser [a]
p `sepby1` sep =
  do x  <- p
     xs <- many (do {sep; p})
     return (x:xs)

chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op v =
  (p `chainl1` op) +++ return v

chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
p `chainl1` op =
   do x <- p
      rest x
 where rest x = do {f <- op; y <- p; rest (f x y)}
                  +++ return x

-- Useful parsers: ---------------------------------------------------

char :: Char -> Parser Char
char x = sat (x ==)

digit :: Parser Int
digit = do x <- sat isDigit
           return (ord x - ord '0')

lower :: Parser Char
lower = sat isLower

upper :: Parser Char
upper = sat isUpper

letter :: Parser Char
letter = sat isAlpha

alphanum :: Parser Char
alphanum = sat isAlphaNum

symb :: String -> Parser String
symb xs = token (string xs)

ident :: [String] -> Parser String
ident ks =
   do x <- token identifier
      if (not (elem x ks)) then return x else mzero


identifier :: Parser String
identifier =
   do x <- lower
      xs <- many alphanum
      return (x:xs)

nat :: Parser Int
nat = token natural

natural :: Parser Int
natural = digit `chainl1` return (\m n -> 10*m + n)

int :: Parser Int
int = token integer

integer :: Parser Int
integer = (do char '-'
              n <- natural
              return (-n)) +++ nat

-- Lexical combinators: ----------------------------------------------

spaceP :: Parser ()
spaceP = do {many1 (sat isSpace); return ()}

comment :: Parser ()
comment = do string "--"
             many (sat p)
             return ()
  where p x = x /= '\n'

junk :: Parser ()
junk = do {many (spaceP +++ comment); return ()}

token :: Parser a -> Parser a
token p = do {v <- p; junk; return v}

parse :: Parser a -> String -> [(a,String)]
parse p = applyP (do {junk; p})

-- Example parser for arithmetic expressions: ------------------------

data Term = Add Term Term
          | Sub Term Term
          | Mult Term Term
          | Div Term Term
          | Const Int

expr  :: Parser Term
addop :: Parser (Term -> Term -> Term)
mulop :: Parser (Term -> Term -> Term)

expr   = term   `chainl1` addop
term   = factor `chainl1` mulop
factor = (do n <- token digit
             return (Const n))  +++
          (do symb "("
              n <- expr
              symb ")"
              return n)

addop  = do {symb "+"; return Add} +++
          do {symb "-"; return Sub}

mulop  = do {symb "*"; return Mult} +++
          do {symb "/"; return Div}

--===================================================================
ex1 = parse item "abc"
ex2 = parse (sat isSpace) "abc"
ex3 = parse expr "4 + 5 - 2"

--====================================================================

type Subword  = (Int,Int)

newtype P a = P (Array Int Char -> Subword -> [a])
unP (P z) = z

emptyP :: P ()
emptyP = P f
  where f z (i,j) = [() | i == j]

notchar :: Char -> P Char
notchar s = P f
  where f z (i,j) = [z!j | i+1 == j, z!j /= s]

charP :: Char -> P Char
charP c = P f
  where f z (i,j) =  [c | i+1 == j, z!j == c]

anychar :: P Char
anychar = P f
  where f z (i,j) = [z!j | i+1 == j]

anystring :: P(Int,Int)
anystring = P f
  where f z (i,j) = [(i,j) | i <= j]

symbol :: String -> P (Int,Int)
symbol s = P f
  where f z (i,j) = if j-i == length s
                       then [(i,j)| and [z!(i+k) == s!!(k-1) | k <-[1..(j-i)]]]
                       else []


infixr 6 |||
(|||)           :: P b -> P b -> P b
(|||) (P r) (P q) = P f
   where f z (i,j) = r z (i,j) ++ q z (i,j)

infix  8 <<<
(<<<)  :: (b -> c) -> P b -> P c
(<<<) f (P q) = P h
   where h z (i,j) =  map f (q z (i,j))

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

infix  5 ...
(...)  :: P b -> ([b] -> [b]) -> P b
(...) (P r) h = P g
    where g z (i,j) = h (r z (i,j))

type Filter    =  (Int, Int) -> Bool
withX  :: P b -> Filter -> P b
withX (P q) c = P g
   where g z (i,j) =  if c (i,j) then q z (i,j)  else []

run :: String -> P b -> [b]
run s (P ax) =  ax (s2a s) (0,length s)

s2a s = (array bounds (zip [1..] s))
  where bounds = (1,length s)

instance Monad P where
  return x = P(\ z (i,j) -> if i==j then [x] else [])
  (>>=) (P f) g = P h
    where h z (i,j) = concat[ unP (g a) z (k,j) | k <- [i..j] , a <- f z (i,k)]

p1 = do { symbol "tim"; c <- anychar; symbol "tom"; return c}

ex4 = run "tim5tom" p1
ex5 = run "timtom" p1



-- </pre>