--
--  paired.hs
--
--  Church Numerals with added strings!
--
--  Copyright (C) 2011 Martin Oldfield <m@mjo.tc>
--  
--  This file is free software; you can redistribute it and/or modify it
--  under the terms of the GNU Lesser General Public License as
--  published by the Free Software Foundation; either version 2.1 of the
--  License, or (at your option) any later version.
--

type ChPair t = ((t -> t) -> t -> t, String)

pp :: Num t => ChPair t -> t
pp (f,_) = f (1+) 0

pq :: ChPair t -> String
pq = snd

zero :: ChPair t
zero = (\f x -> x, "\\s z -> z")

one :: ChPair t
one = (\f -> f, "\\s z -> s z")

two :: ChPair t
two = (\f -> f . f, "\\s z -> (s . s) z")

three :: ChPair t
three = (\f -> f . f . f, "\\s z -> (s . s . s) z")

(<+>) (ff,fs) (gf,gs) = ((\s -> (ff s) . (gf s)),
                         "\\s z -> (((" ++ fs ++ ") s) . ((" ++ gs ++ ") s)) z")

(<*>) (ff,fs) (gf,gs) = (ff . gf, 
                         "\\s z -> ((" ++ fs ++ ") . (" ++ gs ++ ")) s z")

(<^>) (ff,fs) (gf,gs) = (gf ff,
                         "\\s z -> ((" ++ gs ++ ") (" ++ fs ++ ")) s z")


demo :: String
demo = concatMap test demo_data

test (ch, n) =     "N: "  ++ show n
               ++ " PP: " ++ show n'
               ++ ok (n == n') 
               ++ " PQ: " ++ pq ch
               ++ "\n"
    where n' = pp ch
          ok True  = " OK"
          ok False = " FAIL"

demo_data = zip [zero, one, two, three, four, five, six, seven, eight, nine ]
                [0 .. ]
    where four  = two   <*> two
          five  = two   <+> three
          six   = two   <*> three
          seven = six   <+> one
          eight = two   <^> three
          nine  = three <^> two

millionPi = seven <*> thirteen <*> nineteen <*> twentythree <*> seventynine
    where seven        = two <*> three <+> one
          thirteen     = two <*> two <*> three <+> one
          sixteen      = (two <*> two) <^> two
          nineteen     = sixteen <+> three
          twentythree  = sixteen <+> seven
          seventynine  = two <*> three <*> thirteen <+> one