{-# OPTIONS_GHC -fglasgow-exts #-}

{-
  Representative thingies..

  A little hack to pair values with string representations
  of their expressions. Useful if you want to explain what

    map (+1) [1..4] or foldr1 (*) [1..5]

  do, or if you want to demonstrate the difference between 

    foldr (+) 0 [1..4] and foldl (+) 0 [1..4]

  Load this module into Hugs (Hugs mode) and type in some of 
  these examples to get an idea of what I mean. Also try

    map (+) [1..4]
  
  This could be extended in various directions, but I wanted to 
  keep things simple. I'm not convinced that extra complications 
  would be worth the effort.

  Claus Reinke

  more examples:

    *Main Control.Monad.Reader> ap (*) (+2) 0 :: R Int
    (0 * (0 + 2))
    *Main Control.Monad.Reader> ap (*) (+2) :: R Int -> R Int
    \x->(x * (x + 2))
    *Main Control.Monad.Reader> join (*) :: R Int -> R Int
    \x->(x * x)
    *Main Control.Monad.Reader> liftM2 (*) (+1) (+2) :: R Int -> R Int
    \x->((x + 1) * (x + 2))

    *Main Control.Monad.Reader> do { x <- (+1); y <- (*2); return (x+y)} :: R Int -> R Int
    \x->((x + 1) + (x * 2))


    *Main Control.Monad.Reader> (+) :: R Int -> R Int -> R Int
    \x y->(x + y)
    *Main Control.Monad.Reader> (+1) :: R Int -> R Int
    \x->(x + 1)
    *Main Control.Monad.Reader> (1+) :: R Int -> R Int
    \x->(1 + x)

-}

module R where

import Prelude hiding (($))
import qualified Prelude (($))

default (R Integer)

data R a = R {rep:: String
             ,val:: a
             }

instance Show (R a) where
  showsPrec _ a = showString (rep a)

instance Show (R a -> R b) where
  showsPrec _ f = showString ("\\x->"++(rep (f x)))
    where
      x = R{rep="x",val=error "variable"}

instance Show (R a -> R b -> R c) where
  showsPrec _ f = showString ("\\x y->"++(rep (f x y)))
    where
      x = R{rep="x",val=error "variable"}
      y = R{rep="y",val=error "variable"}

lift1 op a = R {rep="("++(rep op)++" "++(rep a)++")"
               ,val= (   (val op)       (val a)   )
               }

lift2 op a b  = R {rep="("++(rep op)++" "++(rep a)++" "++(rep b)++")"
                  ,val= (   (val op)       (val a)       (val b)   )
                  }

lift2infix op a b  = R {rep="("++(rep a)++" "++(rep op)++" "++(rep b)++")"
                       ,val= (   (val a)          `iop`       (val b)   )
                       }
                       where
                        iop = val op

($) = lift2infix R {rep="$",val=(Prelude.$)}
var x = R { rep=x, val=error ("variable "++x) }

instance (Num a,Show a) => Num (R a) where
  (+)    = lift2infix R{rep="+",val=(+)}
  (-)    = lift2infix R{rep="-",val=(-)}
  (*)    = lift2infix R{rep="*",val=(*)}
  negate = lift1 R{rep="-",val=negate}
  fromInteger a = (\fIa->R{rep=show fIa,val=fIa}) (fromInteger a)

instance (Eq a,Num a) => Eq (R a) where
  a == b = (val a) == (val b)

instance (Ord a,Num a) => Ord (R a) where
  a <= b = (val a) <= (val b)

instance (Enum a,Num a,Show a) => Enum (R a) where
  fromEnum   = fromEnum.val
  toEnum   a = R{rep=show a,val=toEnum a}
  enumFrom x = map toEnum [fromEnum x..] -- missing in Hugs Prelude..