-- Perform algebraic manipulations on Term structures.

module Cas(CT(U, Z, L, T, (:<*>:)), ctOp) where


-- Commuative reduction is able to propagate ``literal bubbles to the
-- surface'' by keeping semi-literal terms in a (L a :<*>: b) normal form.

data CT l t = U                        -- unit
            | Z                        -- zero
            | L l                      -- literal
            | T t                      -- opaque term
            | (CT l t) :<*>: (CT l t)  -- op
              deriving Show

ctOp :: (Num l) => (l -> l -> l) -> CT l t -> CT l t -> CT l t
ctOp binop = (<*>) where
    (*) = binop

    -- unit and zero
    Z <*> a = Z ;  a <*> Z = Z
    U <*> a = a ;  a <*> U = a

    -- reduce literals/semi-literals: (L a) or (L a :<*>: _)
    L a <*> L b = L (a * b)
    L a <*> (L b :<*>: c) = L (a * b) :<*>: c
    (L a :<*>: b) <*> L c = L (a * c) :<*>: b
    (L a :<*>: b) <*> (L c :<*>: d) = L (a * c) :<*>: (b :<*>: d)

    -- no reduction -> enforce normalized semi-literal form
    a <*> (L b :<*>: c) = L b :<*>: (a :<*>: c)
    (L a :<*>: b) <*> c = L a :<*>: (b :<*>: c)

    -- catch-all 
    a <*> b = a :<*>: b