Cleanup + from(Left|Right)

3 files changed, 11 insertions, 35 deletions

diff --git a/ast.hs b/ast.hs
index 4862a92..11aeb9b 100644
--- a/ast.hs
+++ b/ast.hs
@@ -23,7 +23,7 @@ data AST = Number Double
          | Capture String
          | CaptureTerm String
          | CaptureConstr String AST  -- AST argument only for constructor; only WHNF
-         deriving (Eq,Typeable,Data)
+         deriving (Show,Read,Eq,Typeable,Data)
 
 instance PrettyPrint AST where
     prettyPrint (Number n) = show n
@@ -56,9 +56,6 @@ instance PrettyPrint AST where
 
     prettyPrint (CaptureConstr name c) = '[' : name ++ ":" ++ showConstr (toConstr c) ++ "]"
 
-instance Show AST where
-    show = prettyPrint
-
 instance NFData AST where
     rnf (Number !_) = ()
     rnf (Variable !_) = ()
diff --git a/simplify.hs b/simplify.hs
index f0fcd6e..c62ff4b 100644
--- a/simplify.hs
+++ b/simplify.hs
@@ -21,9 +21,8 @@ tracexp s x = trace (s ++ ": " ++ prettyPrint x) x
 simplify :: AST -> AST
 simplify = tracex "last canonicaliseOrder" . canonicaliseOrder
            . (fixpoint $ tracex "applyPatterns    " . applyPatterns
-                       . tracex "flattenSums      " . flattenSums
-                       -- . tracex "collectLikeTerms " . collectLikeTerms
                        . tracex "canonicaliseOrder" . canonicaliseOrder
+                       . tracex "flattenSums      " . flattenSums
                        . tracex "foldNumbers      " . foldNumbers)
            . tracex "first flattenSums" . flattenSums
 
@@ -61,7 +60,7 @@ foldNumbers node = case node of
         (Negative n) -> Negative $ Reciprocal fn
         (Reciprocal n2) -> n2
         _ -> Reciprocal $ fn
-    (Apply name args) -> let fargs = map foldNumbers args -- Apply name $ map foldNumbers args
+    (Apply name args) -> let fargs = map foldNumbers args
         in case name of
             "pow" -> if all astIsNumber fargs
                          then Number $ astFromNumber (fargs!!0) ** astFromNumber (fargs!!1)
@@ -93,34 +92,6 @@ foldNumbers node = case node of
                   | even x -> Product unnegged
                   | odd x -> Product $ Number (-1) : unnegged
 
--- collectLikeTerms :: AST -> AST
--- collectLikeTerms node = case node of
---     (Reciprocal n) -> Apply "pow" [n,Number $ -1]
---     (Product args) -> 
---         let ispow (Apply "pow" _) = True
---             ispow _ = False
---             (pows,nopows) = partition ispow $ map collectLikeTerms args
---             groups = groupBy (\(Apply _ [x,_]) (Apply _ [y,_]) -> x == y) pows
---             baseof (Apply _ [x,_]) = x
---             expof (Apply _ [_,x]) = x
---             collectGroup l = Apply "pow" [baseof (l!!0),Sum $ map expof l]
---         in Product $ map collectGroup groups ++ nopows
---     (Sum args) ->
---         let isnumterm (Product (Number _:_)) = True
---             isnumterm _ = False
---             (numterms,nonumterms) = partition isnumterm $ map collectLikeTerms args
---             groups = groupBy (\(Product (Number _:xs)) (Product (Number _:ys))
---                               -> astMatchSimple (Product xs) (Product ys))
---                          numterms
---             numof (Product (n:_)) = n
---             restof (Product (_:rest)) = rest
---             collectGroup l =
---                 if length l == 1
---                     then l!!0
---                     else Product $ Sum (map numof l) : restof (l!!0) 
---         in Sum $ map collectGroup groups ++ nonumterms
---     _ -> node
-
 canonicaliseOrder :: AST -> AST
 canonicaliseOrder node = case node of
     (Number _) -> node
diff --git a/utility.hs b/utility.hs
index c442f80..a160cb7 100644
--- a/utility.hs
+++ b/utility.hs
@@ -18,3 +18,11 @@ setcompareBy p a@(x:xs) b = length a == length b && setcompareBy p xs (deleteBy
 deleteIndex :: Int -> [a] -> [a]
 deleteIndex 0 (_:xs) = xs
 deleteIndex i (x:xs) | i > 0 = x : deleteIndex (i-1) xs
+
+fromLeft :: Either a b -> a
+fromLeft (Left a) = a
+fromLeft (Right _) = undefined
+
+fromRight :: Either a b -> b
+fromRight (Left _) = undefined
+fromRight (Right b) = b