# Ticket #114: LambdaMatchExamples.hs

File LambdaMatchExamples.hs, 4.0 KB (added by , 10 years ago) |
---|

Line | |
---|---|

1 | {-# OPTIONS_GHC -fglasgow-exts #-} |

2 | |

3 | -- a few examples of lambda-match use |

4 | -- needs syntax patch for lambda-match! |

5 | |

6 | import ControlMonadMatch |

7 | import ControlMonadMatchInstances |

8 | import Control.Monad |

9 | import Prelude hiding(gcd) |

10 | |

11 | -- case as syntactic sugar |

12 | a x = caseOf x $ (|True->"hi") +++ (|False->"ho") |

13 | |

14 | -- lambda as syntactic sugar |

15 | myId :: a -> a |

16 | myId = splice (|x->x) |

17 | |

18 | -- match failure from the do-notation, without do-notation |

19 | b x = return x >>= ok (|False-> return "hi") |

20 | |

21 | -- if non-exhaustive functions were written as lambda-matches.. |

22 | myHead :: Monad m => [a] -> Match m a |

23 | myHead = (|(h:_)->h) |

24 | |

25 | use l = spliceE (myHead +++ matchError "empty list >here<") l |

26 | |

27 | -- nesting matches |

28 | myAnd = splice $ (nest (|True-> (|True->True) |

29 | +++ (|False->False)) ) |

30 | +++ (nest (|False-> fall_through False)) |

31 | |

32 | -- a couple of examples from the pattern guards thread |

33 | |

34 | -- Conor's varVal example |

35 | |

36 | -- we can separate the group of match alternatives from the uses |

37 | grp :: MonadPlus m => String -> [(String, String)] -> Match m String |

38 | grp = (| x locals | Just y <- lookup x locals -> y) |

39 | +++ (| "X" locals -> "42") |

40 | +++ matchError "var not found" |

41 | |

42 | -- the original |

43 | varVal :: String -> [(String, String)] -> String |

44 | varVal = spliceE grp |

45 | |

46 | -- a variation |

47 | varVals :: String -> [(String, String)] -> [] String |

48 | varVals = allMatches grp |

49 | |

50 | {- note how unreadable this would be without syntactic sugar |

51 | |

52 | varVal :: String -> [(String, String)] -> String |

53 | varVal = splice $ |

54 | (\x locals->Match $ do {Just y <- return $ lookup x locals; return y}) |

55 | +++ |

56 | (\x locals->Match $ do {"X" <- return x; return "42"}) |

57 | +++ |

58 | (\x locals->Match $ return (error "var not found")) |

59 | -} |

60 | |

61 | -- Conor's gcd with inner case |

62 | |

63 | -- his pseudo-syntax |

64 | {- |

65 | gcd x y | compare x y -> |

66 | LT = gcd x (y - x) |

67 | GT = gcd (x - y) y |

68 | gcd x _ = x |

69 | -} |

70 | |

71 | -- the same with lambda-match and nested argument supply |

72 | gcd = splice $ |

73 | (nest (| x y ->compare x y >| |

74 | ((| LT -> gcd x (y - x)) |

75 | +++ (| GT -> gcd (x - y) y)))) |

76 | +++ (| x y -> x) |

77 | |

78 | -- as it happens, we're not doing any real matching |

79 | -- at the outer level, so we can avoid "nest" |

80 | gcd' = splice $ |

81 | (\ x y ->compare x y >| |

82 | ((| LT -> gcd' x (y - x)) |

83 | +++ (| GT -> gcd' (x - y) y))) |

84 | +++ (| x y -> x) |

85 | |

86 | -- in fact, we can do with only one level of matching |

87 | gcd'' x y = caseOf (compare x y) $ |

88 | (| LT -> gcd'' x (y - x)) |

89 | +++ (| GT -> gcd'' (x - y) y) |

90 | +++ (fall_through x) |

91 | |

92 | -- David's mini-expect example |

93 | foo = splice $ |

94 | (| (Left "bar") -> "a") |

95 | +++ (| (Right x) | (b," foo") <- break (==' ') x -> "b " ++ b) |

96 | +++ (| (Left x) | ("foo",c) <- break (==' ') x -> "c " ++ c) |

97 | +++ (| (Right x) | ["Hello",n,"how","are","you",d@(_:_)] <- words x, |

98 | last d == '?' |

99 | -> n ++ " is not here right now, but " ++ n |

100 | ++ " is " ++ init d ++ " fine.") |

101 | +++ (| (Left x) | length x == 13 -> "Unlucky!") |

102 | +++ (| (Right x) -> x) |

103 | +++ (| (Left x) -> x) |

104 | |

105 | {- you do not want to write this without syntactic sugar.. |

106 | |

107 | foo :: Either String String -> String |

108 | foo = splice $ |

109 | (\it->Match $ do { Left "bar" <- return it; return "a"}) |

110 | +++ |

111 | (\it->Match $ do { Right x <- return it; (b," foo") <- return $ break (==' ') x; return $ "b " ++ b}) |

112 | +++ |

113 | (\it->Match $ do { Left x <- return it; ("foo",c) <- return $ break (==' ') x; return $ "c " ++ c}) |

114 | +++ |

115 | (\it->Match $ do { Right x <- return it; |

116 | ["Hello",n,"how","are","you",d@(_:_)] <- return $ words x; |

117 | guard $ last d == '?'; |

118 | return $ n ++ " is not here right now, but " ++ n |

119 | ++ " is " ++ init d ++ " fine."}) |

120 | +++ |

121 | (\it->Match $ do { Left x <- return it; guard $ length x == 13; return "Unlucky!"}) |

122 | +++ |

123 | (\it->Match $ do { Right x <- return it; return x}) |

124 | +++ |

125 | (\it->Match $ do { Left x <- return it; return x}) |

126 | -} |

127 |