{-# LANGUAGE
    FlexibleInstances,
    TypeSynonymInstances,
    NoMonomorphismRestriction #-}

-- coalgebraic representation of DSP syntax.  See:
-- http://www.cs.rutgers.edu/~ccshan/tagless/jfp.pdf

module Sym (Symantics(..)
           ,TypeOf(..)
           ,Tfloat
           ,Tint
           ,Tbool
           ) where

-- These mostly serve as phantom types for indexing representation
-- type constructors, except that they are also used as concrete types
-- for int,float,bool literals.
type Tfloat = Double
type Tint   = Integer
type Tbool  = Bool


------ CORE SYNTAX CLASS
--
-- Higher-order abstract syntax implemented as a type class.
--
-- Instances of this class implement semantics, hence the punny name.
--
-- Notation: The `r' parameter refers to "representation".  The `t'
-- parameter refer to language base types, which are wrapped in a
-- representation.

type Binary repr t = repr t -> repr t -> repr t
type Unary  repr t = repr t -> repr t

-- Allow for growth, not everything is there yet.
ni _ = error "Not implemented"


class (Show (repr Tint),   Eq (repr Tint),
       Show (repr Tfloat), Eq (repr Tfloat)) 
      => Symantics repr where
  -- Literals
  iVal :: Tint   -> repr Tint
  fVal :: Tfloat -> repr Tfloat
  bVal :: Tbool  -> repr Tbool
  
  -- Integer primitives
  isign :: Unary repr Tint
  iabs  :: Unary repr Tint
  
  iadd  :: Binary repr Tint
  isub  :: Binary repr Tint
  imul  :: Binary repr Tint
  idiv  :: Binary repr Tint
  imod  :: Binary repr Tint
  
  ieq   :: repr Tint -> repr Tint -> repr Tbool
  
  -- Float primitives
  fsign :: Unary repr Tfloat
  fabs  :: Unary repr Tfloat
  
  fadd  :: Binary repr Tfloat
  fsub  :: Binary repr Tfloat
  fmul  :: Binary repr Tfloat
  fdiv  :: Binary repr Tfloat
  
  fsin  :: Unary repr Tfloat
  fcos  :: Unary repr Tfloat
  fexp  :: Unary repr Tfloat
  
  feq   :: repr Tfloat -> repr Tfloat -> repr Tbool
  
  -- Conditional
  if_ :: repr Tbool -> repr a -> repr a -> repr a
  
  -- Type converssions
  i2f   :: repr Tint   -> repr Tfloat
  f2i   :: repr Tfloat -> repr Tint

  -- Sharing
  let_  :: repr a -> (repr a -> repr b) -> repr b

  -- Default implementation just substitutes
  let_ term body = body term


  -- i2f = ni
  -- f2i = ni
  ieq = ni
  feq = ni



------ NUMBER INSTANCES

instance Symantics repr => Num (repr Tint) where
  (+) = iadd
  (*) = imul
  (-) = isub
  fromInteger = iVal
  abs = iabs
  signum = isign
  
instance Symantics repr => Num (repr Tfloat) where
  (+) = fadd
  (*) = fmul
  (-) = fsub
  fromInteger = fVal . fromInteger
  abs = fabs
  signum = fsign


instance Symantics repr => Enum (repr Tint) where
  toEnum   = ni
  fromEnum = ni
  
instance Symantics repr => Real (repr Tint) where
  toRational = ni
  
instance Symantics repr => Ord  (repr Tint)


instance Symantics repr => Integral (repr Tint) where
  div = idiv
  mod = imod
  quotRem = ni
  toInteger = ni
  
-- instance Symantics repr => RealFrac (repr Tint) where
-- Needs Fractional ?  

instance Symantics repr => Fractional (repr Tfloat) where
  (/) = fdiv
  fromRational = fVal . fromRational

instance Symantics repr => Floating (repr Tfloat) where
  pi = fVal pi  
  exp = fexp
  sin = fsin
  cos = fcos
  
  logBase = ni
  (**) = ni
  log = ni
  sqrt = ni
  tan = ni
  asin = ni
  acos = ni
  atan = ni
  sinh = ni
  cosh = ni
  tanh = ni
  asinh = ni
  acosh = ni
  atanh = ni




-- Handy for concrete syntax generation.

class TypeOf t where typeOf :: t -> String
instance TypeOf Tbool  where typeOf _ = "bool"
instance TypeOf Tint   where typeOf _ = "int"
instance TypeOf Tfloat where typeOf _ = "float"