From feb0e2129ee4b65c8dc4f1e3c7a532908418d417 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 17 Jun 2016 10:05:02 +0200
Subject: Bugfixing, more patterns!

---
 ast.hs | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

(limited to 'ast.hs')

diff --git a/ast.hs b/ast.hs
index 1e267c1..4862a92 100644
--- a/ast.hs
+++ b/ast.hs
@@ -72,16 +72,16 @@ instance NFData AST where
     rnf (CaptureConstr !_ !_) = ()  -- explicitly not deepseq'ing the ast node
 
 instance Ord AST where
-    compare (Number _) (Number _) = EQ
-    compare (Variable _) (Variable _) = EQ
-    compare (Sum _) (Sum _) = EQ
-    compare (Product _) (Product _) = EQ
-    compare (Negative _) (Negative _) = EQ
-    compare (Reciprocal _) (Reciprocal _) = EQ
-    compare (Apply _ _) (Apply _ _) = EQ
-    compare (Capture _) (Capture _) = EQ
-    compare (CaptureTerm _) (CaptureTerm _) = EQ
-    compare (CaptureConstr _ _) (CaptureConstr _ _) = EQ
+    compare (Number a) (Number b) = compare a b
+    compare (Variable a) (Variable b) = compare a b
+    compare (Sum a) (Sum b) = compare a b
+    compare (Product a) (Product b) = compare a b
+    compare (Negative a) (Negative b) = compare a b
+    compare (Reciprocal a) (Reciprocal b) = compare a b
+    compare (Apply n1 a) (Apply n2 b) = let r = compare n1 n2 in if r == EQ then compare a b else r
+    compare (Capture a) (Capture b) = compare a b
+    compare (CaptureTerm a) (CaptureTerm b) = compare a b
+    compare (CaptureConstr n1 node1) (CaptureConstr n2 node2) = let r = compare n1 n2 in if r == EQ then compare node1 node2 else r
 
     compare (Capture _) _ = LT  -- Unbounded captures first for efficient
     compare _ (Capture _) = GT  -- extraction with span isCapture
@@ -114,6 +114,10 @@ astIsCapture (Capture _) = True
 astIsCapture _ = False
 
 
+astFromNumber :: AST -> Double
+astFromNumber (Number n) = n
+
+
 astMatchSimple :: AST -> AST -> Bool
 astMatchSimple pat sub = let res = {-(\x -> trace (" !! RESULT: " ++ show x ++ " !! ") x) $-} astMatch pat sub
     in if null res
@@ -159,7 +163,7 @@ astMatch pat sub = assertS "No captures in astMatch subject" (not $ hasCaptures
             _ -> []
 
         Apply name l -> case sub of
-            Apply name l2 -> matchOrderedList l l2
+            Apply name2 l2 | name == name2 -> matchOrderedList l l2
             _ -> []
 
         Capture name -> [Map.singleton name sub]
-- 
cgit v1.2.3-54-g00ecf