diff options
Diffstat (limited to 'simplify.hs')
| -rw-r--r-- | simplify.hs | 33 |
1 files changed, 2 insertions, 31 deletions
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 |