module Type where import HSE.All import Data.Char import Data.List import Data.Maybe import Data.Ord --------------------------------------------------------------------- -- GENERAL DATA TYPES data Rank = Ignore | Warning | Error deriving (Eq,Ord,Show) -- (modulename,functionname) -- either being blank implies universal matching type FuncName = (String,String) --------------------------------------------------------------------- -- IDEAS/SETTINGS -- Classify and MatchExp are read from the Settings file -- Idea are generated by the program data Idea = Classify {func :: FuncName, rank :: Rank, hint :: String} | MatchExp {rank :: Rank, hint :: String, lhs :: Exp, rhs :: Exp, side :: Maybe Exp} | Idea {func :: FuncName, rank :: Rank, hint :: String, loc :: SrcLoc, from :: String, to :: String} deriving Eq type Setting = Idea isClassify Classify{} = True; isClassify _ = False isMatchExp MatchExp{} = True; isMatchExp _ = False instance Show Idea where show (MatchExp x _ y z q) = unlines $ ("MatchExp " ++ show x) : map (\x -> " " ++ prettyPrint x) ([y,z] ++ maybeToList q) show (Classify x y z) = unwords ["Classify",show x,show y,show z] show x = unlines $ [showSrcLoc (loc x) ++ " " ++ show (rank x) ++ ": " ++ hint x] ++ f "Found" from ++ f "Why not" to where f msg sel = (msg ++ ":") : map (" "++) (lines $ sel x) showList = showString . concatMap show -- The real key will be filled in by applyHint idea rank hint loc from to = Idea ("","") rank hint loc (prettyPrint from) (prettyPrint to) warn mr = idea Warning mr -- Any 1-letter variable names are assumed to be unification variables isUnifyVar :: String -> Bool isUnifyVar [x] = x == '?' || isAlpha x isUnifyVar _ = False --------------------------------------------------------------------- -- HINTS type Hint = Decl -> [Idea] concatHints :: [Hint] -> Hint concatHints hs x = concatMap ($x) hs applyHint :: Hint -> Module -> [Idea] applyHint h m = [i{func = (name,declName d)} | d <- moduleDecls m, i <- sortBy (comparing loc) $ h d] where name = moduleName m