diff options
author | tomsmeding <tom.smeding@gmail.com> | 2016-06-17 10:05:02 +0200 |
---|---|---|
committer | tomsmeding <tom.smeding@gmail.com> | 2016-06-17 10:05:02 +0200 |
commit | feb0e2129ee4b65c8dc4f1e3c7a532908418d417 (patch) | |
tree | 9a258c9c71578677c676b73961f782b4b08922e1 /ast.hs | |
parent | dd3db844dd49451f28d044cd1d2fd71430d73686 (diff) |
Bugfixing, more patterns!
Diffstat (limited to 'ast.hs')
-rw-r--r-- | ast.hs | 26 |
1 files changed, 15 insertions, 11 deletions
@@ -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] |