shithub: MicroHs

Download patch

ref: 15d2ec82235497c58d796353b38bb41955ff9700
parent: 167b705bc7becf8a61fb3c9376c389ae8364dc6f
author: Lennart Augustsson <lennart@augustsson.net>
date: Sun Oct 29 12:29:34 EDT 2023

More Monads

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1148
-((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Applicative.pure"))) ((A :7 (K (noDefault "Applicative.<*>"))) ((A :8 (((S' B) _3) (((C' _115) _1) _107))) ((A :9 (((S' B) _3) (((C' _118) _1) _108))) ((A :10 _980) ((A :11 ((B _1022) _10)) ((A :12 (((S' _1022) _10) I)) ((A :13 _950) ((A :14 (_13 "undefined")) ((A :15 I) ((A :16 (((C' B) _979) ((C _106) _15))) ((A :17 (((C' _16) ((_114 _993) _95)) ((_106 (_23 _995)) _94))) ((A :18 ((B ((S _1022) (_23 _995))) _13)) ((A :19 ((B (B (B C))) ((B (B C)) P))) ((A :20 (T (BK (BK K)))) ((A :21 (T (K (BK K)))) ((A :22 (T (K (K K)))) ((A :23 (T (K (K A)))) ((A :24 (K (noDefault "Monad.>>="))) ((A :25 (((C' (C' B)) _21) K)) ((A :26 ((B _2) _20)) ((A :27 (((S' (C' B)) _21) (((S' (C' B)) _21) (B' _23)))) ((A :28 P) ((A :29 (T K)) ((A :30 (T A)) ((A :31 (K _13)) ((A :32 ((B (B Y)) (((S' B) (B' ((B P) ((C _23) _150)))) (((S' (C' B)) ((B (B (C' B))) (B' _21))) (((S' (C' (C' B))) (B' _21)) (((C' B) (B' _23)) _151)))))) ((A :33 ((B (B Y)) (((S' B) (B' ((B P) ((C _23) _908)))) (((C' (C' B)) ((B (B (C' B))) (B' _21))) BK)))) ((A :34 ((B T) ((C _23) _908))) ((A :35 ((C _32) _107)) ((A :36 ((B _109) _21)) ((A :37 ((B C) ((B C') _21))) ((A :38 ((B _109) _37)) ((A :39 T) ((A :40 ((_113 ((B (B (_104 _39))) ((B ((C' C) _43)) (B P)))) (_117 _40))) ((A :41 (((((_0 _40) ((B (_104 _39)) P)) (_27 _42)) ((B (B (_104 _39))) (((C' B) ((B C) _43)) (BK _43)))) (_9 _41))) ((A :42 ((((_19 _41) ((B (B (_104 _39))) (((C' B) ((B C) _43)) (B _43)))) (_4 _41)) (_2 _41))) ((A :43 (T I)) ((A :44 ((B (_106 _238)) _43)) ((A :45 ((B (_104 _39)) (B (P _908)))) ((A :46 ((B (_104 _39)) (BK (P _908)))) ((A :47 ((_104 _39) ((S P) I))) ((A :48 ((B (_104 _39)) ((C (S' P)) I))) ((A :49 (R _56)) ((A :50 (T _55)) ((A :51 ((P _56) _55)) ((A :52 _56) ((A :53 ((C ((C S') _51)) I)) ((A :54 ((C S) _51)) ((A :55 K) ((A :56 A) ((A :57 ((_98 _944) _945)) ((A :58 ((_98 _954) (_102 _58))) ((A :59 _955) ((A :60 _956) ((A :61 (((S' _50) (_947 #97)) ((C _947) #122))) ((A :62 (((S' _50) (_947 #65)) ((C _947) #90))) ((A :63 (((S' _49) _61) _62)) ((A :64 (((S' _50) (_947 #48)) ((C _947) #57))) ((A :65 (((S' _50) (_947 #32)) ((C _947) #126))) ((A :66 _944) ((A :67 _945) ((A :68 _947) ((A :69 _946) ((A :70 (((S' _49) ((C (_99 _57)) #32)) (((S' _49) ((C (_99 _57)) #9)) ((C (_99 _57)) #10)))) ((A :71 ((S ((S (((S' _50) (_68 #65)) ((C _68) #90))) (_56 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _59) (((C' _119) (((C' _120) _60) (_60 #65))) (_60 #97))))) ((A :72 ((S ((S (((S' _50) (_68 #97)) ((C _68) #97))) (_56 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _59) (((C' _119) (((C' _120) _60) (_60 #97))) (_60 #65))))) ((A :73 _915) ((A :74 _916) ((A :75 _917) ((A :76 _918) ((A :77 (_74 %0.0)) ((A :78 _73) ((A :79 _74) ((A :80 _75) ((A :81 _76) ((A :82 ((_98 _919) _920)) ((A :83 (_99 _82)) ((A :84 (_100 _82)) ((A :85 _921) ((A :86 _922) ((A :87 _923) ((A :88 _924) ((A :89 _85) ((A :90 _86) ((A :91 _87) ((A :92 _88) ((A :93 _925) ((A :94 ((B BK) T)) ((A :95 (BK T)) ((A :96 (((S' _98) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _99) (T K)))) (K _55)))) ((B ((C' B) (T (K _55)))) ((B _99) (T A))))) ((B _102) ((B _96) (((S' P) (T K)) (T A)))))) ((A :97 P) ((A :98 P) ((A :99 (T K)) ((A :100 (T A)) ((A :101 (K (noDefault "Eq.=="))) ((A :102 ((B (B (B _51))) _99)) ((A :103 ((_98 ((C ((C S') _51)) I)) (_102 _103))) ((A :104 I) ((A :105 (S _952)) ((A :106 B) ((A :107 I) ((A :108 K) ((A :109 C) ((A :110 _951) ((A :111 ((C ((C S') _238)) _239)) ((A :112 (((C' (S' (C' B))) B) I)) ((A :113 P) ((A :114 (T K)) ((A :115 (T A)) ((A :116 (K (noDefault "Functor.fmap"))) ((A :117 (((C' _106) _114) _108)) ((A :118 _114) ((A :119 _909) ((A :120 _910) ((A :121 _911) ((A :122 _912) ((A :123 _913) ((A :124 _914) ((A :125 (_120 #0)) ((A :126 ((_98 _932) _933)) ((A :127 _934) ((A :128 _935) ((A :129 _936) ((A :130 _937) ((A :131 (BK K)) ((A :132 ((B BK) ((B (B BK)) P))) ((A :133 ((B (B (B BK))) ((B (B (B BK))) ((B
\ No newline at end of file
+1154
+((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Applicative.pure"))) ((A :7 (K (noDefault "Applicative.<*>"))) ((A :8 (((S' B) _3) (((C' _122) _1) _114))) ((A :9 (((S' B) _3) (((C' _125) _1) _115))) ((A :10 _986) ((A :11 ((B _1028) _10)) ((A :12 (((S' _1028) _10) I)) ((A :13 _956) ((A :14 (_13 "undefined")) ((A :15 I) ((A :16 (((C' B) _985) ((C _113) _15))) ((A :17 (((C' _16) ((_121 _999) _102)) ((_113 (_23 _1001)) _101))) ((A :18 ((B ((S _1028) (_23 _1001))) _13)) ((A :19 ((B (B (B C))) ((B (B C)) P))) ((A :20 (T (BK (BK K)))) ((A :21 (T (K (BK K)))) ((A :22 (T (K (K K)))) ((A :23 (T (K (K A)))) ((A :24 (K (noDefault "Monad.>>="))) ((A :25 (((C' (C' B)) _21) K)) ((A :26 ((B _2) _20)) ((A :27 (((S' (C' B)) _21) (((S' (C' B)) _21) (B' _23)))) ((A :28 P) ((A :29 (T K)) ((A :30 (T A)) ((A :31 (K _13)) ((A :32 ((B (B Y)) (((S' B) (B' ((B P) ((C _23) _157)))) (((S' (C' B)) ((B (B (C' B))) (B' _21))) (((S' (C' (C' B))) (B' _21)) (((C' B) (B' _23)) _158)))))) ((A :33 ((B (B Y)) (((S' B) (B' ((B P) ((C _23) _914)))) (((C' (C' B)) ((B (B (C' B))) (B' _21))) BK)))) ((A :34 ((B T) ((C _23) _914))) ((A :35 ((C _32) _114)) ((A :36 ((B _116) _21)) ((A :37 ((B C) ((B C') _21))) ((A :38 ((B _116) _37)) ((A :39 ((_120 _164) (_124 _39))) ((A :40 (((((_0 _39) ((C O) K)) (_27 _41)) (_8 _40)) (_9 _40))) ((A :41 ((((_19 _40) (_116 _163)) (_25 _41)) (_26 _41))) ((A :42 ((_28 _41) (K _157))) ((A :43 ((_120 ((B (P _232)) (B _233))) (_124 _43))) ((A :44 (((((_0 _43) _233) (_27 _45)) (_8 _44)) (_9 _44))) ((A :45 ((((_19 _44) (T _232)) (_25 _45)) (_26 _45))) ((A :46 T) ((A :47 ((_120 ((B (B (_111 _46))) ((B ((C' C) _50)) (B P)))) (_124 _47))) ((A :48 (((((_0 _47) ((B (_111 _46)) P)) (_27 _49)) ((B (B (_111 _46))) (((C' B) ((B C) _50)) (BK _50)))) (_9 _48))) ((A :49 ((((_19 _48) ((B (B (_111 _46))) (((C' B) ((B C) _50)) (B _50)))) (_4 _48)) (_2 _48))) ((A :50 (T I)) ((A :51 ((B (_113 _244)) _50)) ((A :52 ((B (_111 _46)) (B (P _914)))) ((A :53 ((B (_111 _46)) (BK (P _914)))) ((A :54 ((_111 _46) ((S P) I))) ((A :55 ((B (_111 _46)) ((C (S' P)) I))) ((A :56 (R _63)) ((A :57 (T _62)) ((A :58 ((P _63) _62)) ((A :59 _63) ((A :60 ((C ((C S') _58)) I)) ((A :61 ((C S) _58)) ((A :62 K) ((A :63 A) ((A :64 ((_105 _950) _951)) ((A :65 ((_105 _960) (_109 _65))) ((A :66 _961) ((A :67 _962) ((A :68 (((S' _57) (_953 #97)) ((C _953) #122))) ((A :69 (((S' _57) (_953 #65)) ((C _953) #90))) ((A :70 (((S' _56) _68) _69)) ((A :71 (((S' _57) (_953 #48)) ((C _953) #57))) ((A :72 (((S' _57) (_953 #32)) ((C _953) #126))) ((A :73 _950) ((A :74 _951) ((A :75 _953) ((A :76 _952) ((A :77 (((S' _56) ((C (_106 _64)) #32)) (((S' _56) ((C (_106 _64)) #9)) ((C (_106 _64)) #10)))) ((A :78 ((S ((S (((S' _57) (_75 #65)) ((C _75) #90))) (_63 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _66) (((C' _126) (((C' _127) _67) (_67 #65))) (_67 #97))))) ((A :79 ((S ((S (((S' _57) (_75 #97)) ((C _75) #97))) (_63 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _66) (((C' _126) (((C' _127) _67) (_67 #97))) (_67 #65))))) ((A :80 _921) ((A :81 _922) ((A :82 _923) ((A :83 _924) ((A :84 (_81 %0.0)) ((A :85 _80) ((A :86 _81) ((A :87 _82) ((A :88 _83) ((A :89 ((_105 _925) _926)) ((A :90 (_106 _89)) ((A :91 (_107 _89)) ((A :92 _927) ((A :93 _928) ((A :94 _929) ((A :95 _930) ((A :96 _92) ((A :97 _93) ((A :98 _94) ((A :99 _95) ((A :100 _931) ((A :101 ((B BK) T)) ((A :102 (BK T)) ((A :103 (((S' _105) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _106) (T K)))) (K _62)))) ((B ((C' B) (T (K _62)))) ((B _106) (T A))))) ((B _109) ((B _103) (((S' P) (T K)) (T A)))))) ((A :104 P) ((A :105 P) ((A :106 (T K)) ((A :107 (T A)) ((A :108 (K (noDefault "Eq.=="))) ((A :109 ((B (B (B _58))) _106)) ((A :110 ((_105 ((C ((C S') _58)) I)) (_109 _110))) ((A :111 I) ((A :112 (S _958)) ((A :113 B) ((A :114 I) ((A :115 K) ((A :116 C) ((A :117 _957) ((A :118 ((C ((C S') _244)) _245)) ((A :119 (((C' (S' (C' B))) B) I)) ((A :120 P) ((A :121 (T K)) ((A :122 (T A)) ((A :123
\ No newline at end of file
--- a/lib/Control/Monad.hs
+++ b/lib/Control/Monad.hs
@@ -5,7 +5,9 @@
 import Data.Bool
 import Data.Char
 import Data.Function
+import Data.Functor
 import Data.List
+import Data.Maybe
 
 infixl 1 >>
 infixl 1 >>=
@@ -71,3 +73,30 @@
 infixr 1 >=>
 (>=>) :: forall (m :: Type -> Type) a b c . Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
 (>=>) = flip (<=<)
+
+-- Since we depend on Data.List, these instances cannot go there.
+instance Functor [] where
+  fmap = map
+
+instance Applicative [] where
+  pure a = [a]
+  (<*>) = ap
+
+instance Monad [] where
+  (>>=) = flip concatMap
+
+instance MonadFail [] where
+  fail _ = []
+
+-- Same for Maybe
+instance Functor Maybe where
+  fmap _ Nothing = Nothing
+  fmap f (Just a) = Just (f a)
+
+instance Applicative Maybe where
+  pure a = Just a
+  (<*>) = ap
+
+instance Monad Maybe where
+  Nothing >>= _ = Nothing
+  Just a  >>= f = f a
--- a/lib/Data/List.hs
+++ b/lib/Data/List.hs
@@ -255,7 +255,10 @@
 lookup = lookupBy (==)
 
 lookupBy :: forall a b . (a -> a -> Bool) -> a -> [(a, b)] -> Maybe b
-lookupBy eq x xys = fmapMaybe snd (find (eq x . fst) xys)
+lookupBy eq x xys =
+  case find (eq x . fst) xys of
+    Nothing -> Nothing
+    Just (_, b) -> Just b
 
 union :: forall a . Eq a => [a] -> [a] -> [a]
 union = unionBy (==)
--- a/lib/Data/Maybe.hs
+++ b/lib/Data/Maybe.hs
@@ -20,10 +20,6 @@
 fromMaybe a Nothing = a
 fromMaybe _ (Just a) = a
 
-fmapMaybe :: forall a b . (a -> b) -> Maybe a -> Maybe b
-fmapMaybe _ Nothing = Nothing
-fmapMaybe f (Just a) = Just (f a)
-
 catMaybes :: forall a . [Maybe a] -> [a]
 catMaybes mxs = [ x | Just x <- mxs ]
 
--