ReAssoc.hs

module ReAssoc where
import HsAssoc
import HsIdent
import Recursive

class ReAssoc i e where
  reAssoc :: OperatorEnv i -> e -> e

reAssocRec env = mapRec (reAssoc env)

class HasInfixApp i e a | e->a i where
  infixApp   :: a -> HsIdentI i -> a -> e
  isInfixApp :: e -> Maybe (a,HsIdentI i,a)

class HasInfixDecls i ds where
  getInfixDecls :: ds -> OperatorEnv i

getInfixDeclsRec x = getInfixDecls (struct x)

getInfixes m = oe where OperatorEnv oe = getInfixDecls m
reAssoc' ops = reAssoc (OperatorEnv ops)

--property: This should work.
--proof: it does the same things as HsExpUtil.reassociateE.
reAssocOp env e1 op e2 =
    case isInfixApp e1' of
      Nothing -> e'
      Just (e11,op1,e12) ->
	  if p>p1 || p==p1 && a==a1 && a==HsAssocRight
	  then infixApp e11 op1 (reAssoc env (infixApp e12 op e2))
	  else e'
	where
	  HsFixity a p = getFixity' env op	      
	  HsFixity a1 p1 = getFixity' env op1
  where
    e1' = reAssoc env e1
    e2' = reAssoc env e2
    e' = infixApp e1' op e2'
    getFixity' env = getFixity env . getHSName


instance (Eq i,HasInfixDecls i d) => HasInfixDecls i [d] where
  getInfixDecls = foldr (extend2 . getInfixDecls) emptyOE

instance ReAssoc i d => ReAssoc i [d] where reAssoc = map . reAssoc