On 1/22/08, Benja Fallenstein wrote:

Take a look at how Haskell's derived Show instances do it? :-)

http://www.haskell.org/onlinereport/derived.html#sect10.4

I hate how Haskell handles precedence: 1) Arbitrary magic numbers for precedence, which isn't very natural. 2) Impossible to define operators that have higher precedence than function application. 3) Impossible to define unary operators. 4) Because of (1), impossible to define an operator with higher precedence than + but lower precedence than *, or similar. When I was working through SPJ's "functional languages" book, (see http://research.microsoft.com/~simonpj/Papers/pj-lester-book/) I was determined to do a better job. It's not that hard to define a partial ordering between operators instead of using fixed categories for precedences, so that's what I did. So, given an environment which gives you a partial ordering between operators and fixty declarations (left, right, or nofix), you can write out expressions pretty easily: type Name = String data Operator = OpFunAp | Op Name data PartialOrdering = PoLT | PoGT | PoEQ | PoNC deriving Eq data Fixity = FixLeft | FixRight | FixNone deriving Eq -- type FixityEnv = exercise for the reader -- with operations: -- contains :: FixityEnv -> Operator -> Bool -- comparePrec :: FixityEnv -> Operator -> Operator -> PartialOrdering -- fixity :: FixityEnv -> Operator -> Fixity -- unary operators are also an exercise for the reader -- you could also improve this to use ShowS and (.) -- instead of String and (++) to avoid quadratic slowdown. data FixityContext = FcNone | FcLeft Operator | FcRight Operator parens :: Bool -> String -> String parens False s = s parens True s = "(" ++ s ++ ")" print :: FixityEnv -> FixityContext -> Exp -> String print env ctx (Ap (Ap (Sym operator) left) right) | env `contains` (Op operator) = printBinOp env ctxt operator left right print env ctx (Ap left right) = printAp env ctxt left right print env ctx (Sym name) = parens (env `contains` Op name) name printBinOp :: FixityEnv -> FixityContext -> Name -> Exp -> Exp -> String printBinOp env ctxt op left right = parens (needsParens env ctxt (Op op)) $ concat [ print env (FcLeft $ Op op) left, " " ++ op ++ " ", print env (FcRight $ Op op) right ] printAp :: FixityEnv -> FixityContext -> Exp -> Exp -> String printAp env ctxt op left right = parens (needsParens env ctxt OpFunAp) $ concat [ print env (FcLeft OpFunAp) left, " ", print env (FcRight OpFunAp) right ] needsParens :: FixityEnv -> FixityContext -> Operator -> Bool needsParens _ FcNone _ = False needsParens env (FcLeft ctxt) op | comparePrec env ctxt op == PoLT = False | comparePrec env ctxt op == PoGT = True | comparePrec env ctxt op == PoNC = True -- otherwise the two operators have the same precedence | fixity ctxt /= fixity op = True | fixity ctxt == FixLeft = False | otherwise = True needsParens env (FcRight ctxt) op | comparePrec env ctxt op == PoLT = False | comparePrec env ctxt op == PoGT = True | comparePrec env ctxt op == PoNC = True -- otherwise the two operators have the same precedence | fixity ctxt /= fixity op = True | fixity ctxt == FixRight = False | otherwise = True