diff options
Diffstat (limited to 'AST.hs')
| -rw-r--r-- | AST.hs | 21 |
1 files changed, 11 insertions, 10 deletions
@@ -5,11 +5,10 @@ module AST where import qualified Data.Map.Strict as Map import Data.List import Data.Data -import Data.Typeable import Control.DeepSeq import PrettyPrint -import Debug +-- import Debug data AST = Number Double @@ -40,13 +39,13 @@ instance PrettyPrint AST where prettyPrint (Negative n) = '-' : case n of s@(Sum _) -> '(' : prettyPrint s ++ ")" - n -> prettyPrint n + _ -> prettyPrint n prettyPrint (Reciprocal n) = "1/" ++ case n of s@(Sum _) -> '(' : prettyPrint s ++ ")" s@(Product _) -> '(' : prettyPrint s ++ ")" s@(Reciprocal _) -> '(' : prettyPrint s ++ ")" - n -> prettyPrint n + _ -> prettyPrint n prettyPrint (Apply name args) = name ++ "(" ++ intercalate "," (map prettyPrint args) ++ ")" @@ -113,6 +112,7 @@ astIsCapture _ = False astFromNumber :: AST -> Double astFromNumber (Number n) = n +astFromNumber _ = undefined astMatchSimple :: AST -> AST -> Bool @@ -177,12 +177,13 @@ matchList :: ([AST] -> AST) -- AST constructor for this list (for inserti -> [AST] -- unordered patterns -> [AST] -- unordered subjects -> [Map.Map String AST] -- list of possible capture assignments -matchList constr pats subs = - let ordered = sort pats +matchList constr toppats topsubs = + let ordered = sort toppats (captures,nocaps) = span astIsCapture ordered in assertS "At most one capture in sum/product" (length captures <= 1) $ case captures of - [] -> matchListDBG Nothing nocaps subs - [c] -> matchListDBG (Just c) nocaps subs + [] -> matchListDBG Nothing nocaps topsubs + [c] -> matchListDBG (Just c) nocaps topsubs + _ -> undefined where matchList' :: Maybe AST -> [AST] -> [AST] -> [Map.Map String AST] matchList' Nothing [] [] = [Map.empty] matchList' Nothing [] _ = [] @@ -240,7 +241,7 @@ replaceCaptures mp n = case n of Apply name n2 -> Apply name $ map (replaceCaptures mp) n2 Capture name -> maybe n id $ Map.lookup name mp CaptureTerm name -> maybe n id $ Map.lookup name mp - CaptureConstr name c -> maybe n id $ Map.lookup name mp + CaptureConstr name _ -> maybe n id $ Map.lookup name mp hasCaptures :: AST -> Bool @@ -269,7 +270,7 @@ mapDel :: (a -> [a] -> b) -> [a] -> [b] mapDel _ [] = [] mapDel f l = let splits = zip l - $ map (\(a,b:bs) -> a++bs) + $ map (\(a,_:bs) -> a++bs) $ iterate (\(a,b:bs) -> (a++[b],bs)) ([],l) in map (uncurry f) splits |