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

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

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

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

infixr 5 +++

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

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

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

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

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)