Clean-up precedence printing code.

diff --git a/LTA/Symbolic.hs b/LTA/Symbolic.hs
index 52731236d080413a51bd327f603912351dafadd5..549c70be447150a3e62c82bd44f63903e0d38e83 100644 (file)
--- a/LTA/Symbolic.hs
+++ b/LTA/Symbolic.hs
@@ -34,6 +34,30 @@ import qualified Data.Set as Set
 data SumTag
 data ProductTag
 
 data SumTag
 data ProductTag
 

+powerOp :: (Assoc, Integer, String)
+powerOp = (AssocRight, 8, "^")
+
+mulOp :: (Assoc, Integer, String)
+mulOp = (AssocLeft, 7, "*")
+
+divOpFloat :: (Assoc, Integer, String)
+divOpFloat = (AssocLeft, 7, "/")
+
+divOpInt :: (Assoc, Integer, String)
+divOpInt = (AssocLeft, 7, "//")
+
+modOp :: (Assoc, Integer, String)
+modOp = (AssocLeft, 7, "%")
+
+addOp :: (Assoc, Integer, String)
+addOp = (AssocLeft, 6, "+")
+
+andOp :: (Assoc, Integer, String)
+andOp = (AssocRight, 3, "&&")
+
+orOp :: (Assoc, Integer, String)
+orOp = (AssocRight, 2, "||")
+

 class PairSeqLike e where
   empty :: e
   rebuild :: e -> Expr
 class PairSeqLike e where
   empty :: e
   rebuild :: e -> Expr


@@ -99,23 +123,17 @@ instance PairSeqLike (PairSeq ProductTag Expr) where
                Nothing -> addPair oldSeq (a, b)
 
 instance PrecedenceExpression (PairSeq SumTag Literal) where
                Nothing -> addPair oldSeq (a, b)
 
 instance PrecedenceExpression (PairSeq SumTag Literal) where

-  toPrecExpr pairSeq = buildPrecExprFromPairSeq pairSeq nullOverall addOp mulOp where
-    nullOverall = 0
-    addOp = (AssocLeft, 6, "+") 
-    mulOp = (AssocLeft, 7, "*")
+  toPrecExpr pairSeq = buildPrecExprFromPairSeq pairSeq 0 addOp mulOp where

 
 instance PrecedenceExpression (PairSeq ProductTag Expr) where
 
 instance PrecedenceExpression (PairSeq ProductTag Expr) where

-  toPrecExpr pairSeq = buildPrecExprFromPairSeq pairSeq nullOverall mulOp powerOp where
-    nullOverall = 1
-    mulOp = (AssocLeft, 7, "*")
-    powerOp = (AssocRight, 8, "^") 
+  toPrecExpr pairSeq = buildPrecExprFromPairSeq pairSeq 1 mulOp powerOp where

 
 instance PrecedenceExpression Literal where
   toPrecExpr (FloatLiteral d) = buildAtom $ toDoc d
   toPrecExpr (RationalLiteral r) = if denominator r == 1
     then numToAtom $ numerator r
 
 instance PrecedenceExpression Literal where
   toPrecExpr (FloatLiteral d) = buildAtom $ toDoc d
   toPrecExpr (RationalLiteral r) = if denominator r == 1
     then numToAtom $ numerator r

-    else buildInfix (AssocLeft, 7, "/") (numToAtom $ numerator r) (numToAtom $ denominator r)
-    where numToAtom = buildAtom . toDoc 
+    else buildInfix divOpFloat (numToAtom $ numerator r) (numToAtom $ denominator r)
+    where numToAtom = buildAtom . toDoc

 
 data Expr
   = IntegerSymbol String
 
 data Expr
   = IntegerSymbol String


@@ -219,8 +237,8 @@ instance PrecedenceExpression Expr where
     Product pairSeq -> toPrecExpr pairSeq
     Sum pairSeq -> toPrecExpr pairSeq
     Literal l -> toPrecExpr l
     Product pairSeq -> toPrecExpr pairSeq
     Sum pairSeq -> toPrecExpr pairSeq
     Literal l -> toPrecExpr l

-    Div a b -> buildInfix (AssocLeft, 7, "/") (toPrecExpr a) (toPrecExpr b)
-    Mod a b -> buildInfix (AssocLeft, 7, "%") (toPrecExpr a) (toPrecExpr b)
+    Div a b -> buildInfix divOpInt (toPrecExpr a) (toPrecExpr b)
+    Mod a b -> buildInfix modOp (toPrecExpr a) (toPrecExpr b)

     UnaryFunction f x -> buildAtom $ case toPrecExpr x of
       (PrecExpr _ _ s) -> (toDoc f) <> (parens s)
     Conditional c a b -> PrecExpr AssocNone conditionalPrec val where
     UnaryFunction f x -> buildAtom $ case toPrecExpr x of
       (PrecExpr _ _ s) -> (toDoc f) <> (parens s)
     Conditional c a b -> PrecExpr AssocNone conditionalPrec val where


@@ -237,9 +255,9 @@ instance PrecedenceExpression Cond where
     Compare op left right ->
       buildInfix (AssocNone, 4, render $ toDoc op) (toPrecExpr left) (toPrecExpr right)
     And left right ->
     Compare op left right ->
       buildInfix (AssocNone, 4, render $ toDoc op) (toPrecExpr left) (toPrecExpr right)
     And left right ->

-      buildInfix (AssocRight, 3, "&&") (toPrecExpr left) (toPrecExpr right)
+      buildInfix andOp (toPrecExpr left) (toPrecExpr right)

     Or left right ->
     Or left right ->

-      buildInfix (AssocRight, 2, "||") (toPrecExpr left) (toPrecExpr right)
+      buildInfix orOp (toPrecExpr left) (toPrecExpr right)

     Not e -> PrecExpr AssocNone 8 $ (text "!") <> (value $ toPrecExpr e)
 
       
     Not e -> PrecExpr AssocNone 8 $ (text "!") <> (value $ toPrecExpr e)