on master help sign in
Compatibility with old ghc
19f1e3aEdwin Brady
src/Idris/AbsSyntax.hs+17−5
@@ -1154,6 +1154,18 @@ dumpDecl (PInstance _ _ cs n _ t ds)
1154dumpDecl _ = "..."
1154dumpDecl _ = "..."
1155-- dumpDecl (PImport i) = "import " ++ i
1155-- dumpDecl (PImport i) = "import " ++ i
1156
1156
1157+-- for 6.12/7 compatibility
1158+data EitherErr a b = LeftErr a | RightOK b
1159+
1160+instance Monad (EitherErr a) where
1161+ return = RightOK
1162+
1163+ (LeftErr e) >>= k = LeftErr e
1164+ RightOK v >>= k = k v
1165+
1166+toEither (LeftErr e) = Left e
1167+toEither (RightOK ho) = Right ho
1168+
1157-- syntactic match of a against b, returning pair of variables in a
1169-- syntactic match of a against b, returning pair of variables in a
1158-- and what they match. Returns the pair that failed if not a match.
1170-- and what they match. Returns the pair that failed if not a match.
1159
1171
@@ -1188,9 +1200,9 @@ matchClause x y = checkRpts $ match (fullApp x) (fullApp y) where
1188 return (concat ms)
1200 return (concat ms)
1189 match a@(PAlternative as) b
1201 match a@(PAlternative as) b
1190 = do let ms = zipWith match' as (repeat b)
1202 = do let ms = zipWith match' as (repeat b)
1191− case (rights ms) of
1203+ case (rights (map toEither ms)) of
1192 (x: _) -> return x
1204 (x: _) -> return x
1193− _ -> Left (a, b)
1205+ _ -> LeftErr (a, b)
1194 match (PCase _ _ _) _ = return [] -- lifted out
1206 match (PCase _ _ _) _ = return [] -- lifted out
1195 match (PMetavar _) _ = return [] -- modified
1207 match (PMetavar _) _ = return [] -- modified
1196 match (PQuote _) _ = return []
1208 match (PQuote _) _ = return []
@@ -1215,15 +1227,15 @@ matchClause x y = checkRpts $ match (fullApp x) (fullApp y) where
1215 match Placeholder _ = return []
1227 match Placeholder _ = return []
1216 match (PResolveTC _) _ = return []
1228 match (PResolveTC _) _ = return []
1217 match a b | a == b = return []
1229 match a b | a == b = return []
1218− | otherwise = Left (a, b)
1230+ | otherwise = LeftErr (a, b)
1219
1231
1220− checkRpts (Right ms) = check ms where
1232+ checkRpts (RightOK ms) = check ms where
1221 check ((n,t):xs)
1233 check ((n,t):xs)
1222 | Just t' <- lookup n xs = if t/=t' then Left (t, t')
1234 | Just t' <- lookup n xs = if t/=t' then Left (t, t')
1223 else check xs
1235 else check xs
1224 check (_:xs) = check xs
1236 check (_:xs) = check xs
1225 check [] = Right ms
1237 check [] = Right ms
1226− checkRpts x = x
1238+ checkRpts (LeftErr x) = Left x
1227
1239
1228substMatches :: [(Name, PTerm)] -> PTerm -> PTerm
1240substMatches :: [(Name, PTerm)] -> PTerm -> PTerm
1229substMatches [] t = t
1241substMatches [] t = t