shithub: MicroHs

Download patch

ref: dd2677450c4d6e1bb3a2554b5e89276dac685e63
parent: 39d5ddcff88302a615865b5c9a58b9a82d71bd35
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Fri Oct 13 20:45:04 EDT 2023 

Make it compile


--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-980
-((A :0 _864) ((A :1 ((B _910) _0)) ((A :2 (((S' _910) _0) I)) ((A :3 _834) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _863) ((C _74) _5))) ((A :7 (((C' _6) (_881 _71)) ((_74 _879) _70))) ((A :8 ((B ((S _910) _879)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_74 _189)) _10)) ((A :12 ((B (B (_73 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_73 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_73 _9)) P)) ((A :15 ((B (B (_73 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 ((B (_73 _9)) (B (P _792)))) ((A :18 ((B (_73 _9)) (BK (P _792)))) ((A :19 ((_73 _9) ((S P) I))) ((A :20 ((B (_73 _9)) ((C (S' P)) I))) ((A :21 ((B Y) ((B (B (P (_14 _114)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _115)))))) ((A :22 ((B Y) ((B (B (P (_14 _792)))) ((B (C' B)) (B _13))))) ((A :23 _3) ((A :24 (T (_14 _792))) ((A :25 (_21 _75)) ((A :26 (R _33)) ((A :27 (T _32)) ((A :28 ((P _33) _32)) ((A :29 _33) ((A :30 ((C ((C S') _28)) I)) ((A :31 ((C S) _28)) ((A :32 K) ((A :33 A) ((A :34 _839) ((A :35 _840) ((A :36 (((S' _27) (_831 #97)) ((C _831) #122))) ((A :37 (((S' _27) (_831 #65)) ((C _831) #90))) ((A :38 (((S' _26) _36) _37)) ((A :39 (((S' _27) (_831 #48)) ((C _831) #57))) ((A :40 (((S' _27) (_831 #32)) ((C _831) #126))) ((A :41 _828) ((A :42 _829) ((A :43 _831) ((A :44 _830) ((A :45 (((S' _26) ((C _41) #32)) (((S' _26) ((C _41) #9)) ((C _41) #10)))) ((A :46 ((S ((S (((S' _27) (_43 #65)) ((C _43) #90))) (_33 (((_791 "lib/Data/Char.hs") #3) #8)))) ((B _34) (((C' _81) (((C' _82) _35) (_35 #65))) (_35 #97))))) ((A :47 ((S ((S (((S' _27) (_43 #97)) ((C _43) #97))) (_33 (((_791 "lib/Data/Char.hs") #3) #8)))) ((B _34) (((C' _81) (((C' _82) _35) (_35 #97))) (_35 #65))))) ((A :48 _799) ((A :49 _800) ((A :50 _801) ((A :51 _802) ((A :52 (_49 %0.0)) ((A :53 _48) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _803) ((A :58 _804) ((A :59 _57) ((A :60 _58) ((A :61 _805) ((A :62 _806) ((A :63 _807) ((A :64 _808) ((A :65 _61) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _809) ((A :70 ((B BK) T)) ((A :71 (BK T)) ((A :72 P) ((A :73 I) ((A :74 B) ((A :75 I) ((A :76 K) ((A :77 C) ((A :78 _835) ((A :79 ((C ((C S') _189)) _190)) ((A :80 (((C' (S' (C' B))) B) I)) ((A :81 _793) ((A :82 _794) ((A :83 _795) ((A :84 _796) ((A :85 _797) ((A :86 _798) ((A :87 (_82 #0)) ((A :88 _816) ((A :89 _817) ((A :90 _818) ((A :91 _819) ((A :92 _820) ((A :93 _821) ((A :94 _88) ((A :95 (BK K)) ((A :96 ((B BK) ((B (B BK)) P))) ((A :97 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :98 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _26) (_91 #0))) (_88 #0)))) ((B (B ((C' P) (_86 #1)))) _81))) (C P))) _84)) _85)) ((A :99 _95) ((A :100 (((S' C) ((B (P _177)) (((C' (C' B)) (((C' C) _88) _177)) _178))) ((B ((C' (C' (C' C))) (((C' (C' (C' C))) (((C' (C' (C' (C' S')))) ((B (B (B (B C)))) ((B ((C' (C' (C' C))) ((B (B (B ((S' S') (_88 #0))))) ((B ((C' (C' C)) ((B (B ((S' S') (_88 #1)))) ((B ((C' C) ((B ((C' S') (_88 #2))) (C _100)))) (C _100))))) (C _100))))) (C _100)))) (T K))) (T A)))) ((C _98) #4)))) ((A :101 (_107 _76)) ((A :102 ((_122 (_79 _101)) _99)) ((A :103 ((C (((C' B) ((P _114) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _104)))) (((S' (C' (C' B))) ((B (B (B _104))) (((S' (C' B)) ((B (B _104)) (((C' B) ((B _120) (T #0))) _103))) (((C' B) ((B _120) (T #1))) _103)))) (((C' B) ((B _120) (T #2))) _103)))) (((C' B) ((B _120) (T #3))) _103)))) ((B T) ((B (B P)) ((C' _81) (_83 #4)))))) ((A :104 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C') S) ((B (B (B (S B)))) ((B (B (B (B (B BK))))) ((B ((S' (C' B)) ((B B') B'))) ((B (B (B (B (B (S B)))))) ((B (B (B (B (B (B (B BK))))))) (((C' B) (B' (B' ((B (C' (C' (C' C)))) ((B ((C' B) (B' ((B C) _90)))) ((B ((C' B) _115)) _104)))))) ((B ((C' B) _115)) (C _104)))))))))) (((_791 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :105 ((_74 (_120 _189)) _103)) ((A :106 (((C' C) (((C' C) (C _100)) (_3 "Data.IntMap.!"))) I)) ((A :107 ((B ((C' B) T)) ((B (B Y)) (((C' (C' (S' (S' C)))) ((B ((S' B) ((B (S' P)) (C _96)))) ((B (B ((C' (S' C
\ No newline at end of file
+983
+((A :0 _867) ((A :1 ((B _913) _0)) ((A :2 (((S' _913) _0) I)) ((A :3 _837) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _866) ((C _75) _5))) ((A :7 (((C' _6) (_884 _72)) ((_75 _882) _71))) ((A :8 ((B ((S _913) _882)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_75 _190)) _10)) ((A :12 ((B (B (_74 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_74 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_74 _9)) P)) ((A :15 ((B (B (_74 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_74 _9)) (B (P _795)))) ((A :19 ((B (_74 _9)) (BK (P _795)))) ((A :20 ((_74 _9) ((S P) I))) ((A :21 ((B (_74 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _115)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _116)))))) ((A :23 ((B Y) ((B (B (P (_14 _795)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _795))) ((A :26 (_22 _76)) ((A :27 (R _34)) ((A :28 (T _33)) ((A :29 ((P _34) _33)) ((A :30 _34) ((A :31 ((C ((C S') _29)) I)) ((A :32 ((C S) _29)) ((A :33 K) ((A :34 A) ((A :35 _842) ((A :36 _843) ((A :37 (((S' _28) (_834 #97)) ((C _834) #122))) ((A :38 (((S' _28) (_834 #65)) ((C _834) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_834 #48)) ((C _834) #57))) ((A :41 (((S' _28) (_834 #32)) ((C _834) #126))) ((A :42 _831) ((A :43 _832) ((A :44 _834) ((A :45 _833) ((A :46 (((S' _27) ((C _42) #32)) (((S' _27) ((C _42) #9)) ((C _42) #10)))) ((A :47 ((S ((S (((S' _28) (_44 #65)) ((C _44) #90))) (_34 (((_794 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _82) (((C' _83) _36) (_36 #65))) (_36 #97))))) ((A :48 ((S ((S (((S' _28) (_44 #97)) ((C _44) #97))) (_34 (((_794 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _82) (((C' _83) _36) (_36 #97))) (_36 #65))))) ((A :49 _802) ((A :50 _803) ((A :51 _804) ((A :52 _805) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _806) ((A :59 _807) ((A :60 _58) ((A :61 _59) ((A :62 _808) ((A :63 _809) ((A :64 _810) ((A :65 _811) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _812) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 I) ((A :75 B) ((A :76 I) ((A :77 K) ((A :78 C) ((A :79 _838) ((A :80 ((C ((C S') _190)) _191)) ((A :81 (((C' (S' (C' B))) B) I)) ((A :82 _796) ((A :83 _797) ((A :84 _798) ((A :85 _799) ((A :86 _800) ((A :87 _801) ((A :88 (_83 #0)) ((A :89 _819) ((A :90 _820) ((A :91 _821) ((A :92 _822) ((A :93 _823) ((A :94 _824) ((A :95 _89) ((A :96 (BK K)) ((A :97 ((B BK) ((B (B BK)) P))) ((A :98 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :99 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_92 #0))) (_89 #0)))) ((B (B ((C' P) (_87 #1)))) _82))) (C P))) _85)) _86)) ((A :100 _96) ((A :101 (((S' C) ((B (P _178)) (((C' (C' B)) (((C' C) _89) _178)) _179))) ((B ((C' (C' (C' C))) (((C' (C' (C' C))) (((C' (C' (C' (C' S')))) ((B (B (B (B C)))) ((B ((C' (C' (C' C))) ((B (B (B ((S' S') (_89 #0))))) ((B ((C' (C' C)) ((B (B ((S' S') (_89 #1)))) ((B ((C' C) ((B ((C' S') (_89 #2))) (C _101)))) (C _101))))) (C _101))))) (C _101)))) (T K))) (T A)))) ((C _99) #4)))) ((A :102 (_108 _77)) ((A :103 ((_123 (_80 _102)) _100)) ((A :104 ((C (((C' B) ((P _115) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _105)))) (((S' (C' (C' B))) ((B (B (B _105))) (((S' (C' B)) ((B (B _105)) (((C' B) ((B _121) (T #0))) _104))) (((C' B) ((B _121) (T #1))) _104)))) (((C' B) ((B _121) (T #2))) _104)))) (((C' B) ((B _121) (T #3))) _104)))) ((B T) ((B (B P)) ((C' _82) (_84 #4)))))) ((A :105 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C') S) ((B (B (B (S B)))) ((B (B (B (B (B BK))))) ((B ((S' (C' B)) ((B B') B'))) ((B (B (B (B (B (S B)))))) ((B (B (B (B (B (B (B BK))))))) (((C' B) (B' (B' ((B (C' (C' (C' C)))) ((B ((C' B) (B' ((B C) _91)))) ((B ((C' B) _116)) _105)))))) ((B ((C' B) _116)) (C _105)))))))))) (((_794 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :106 ((_75 (_121 _190)) _104)) ((A :107 (((C' C) (((C' C) (C _101)) (_3 "Data.IntMap.!"))) I)) ((A :108 ((B ((C' B) T)) ((B (B Y)) (((C' (C' (S' (S' C)))) ((B
\ No newline at end of file
--- a/lib/Control/Monad/State/Strict.hs
+++ b/lib/Control/Monad/State/Strict.hs
@@ -31,6 +31,12 @@
 (<$>) :: forall s a b . (a -> b) -> State s a -> State s b
 (<$>) = Control.Monad.State.Strict.fmap
 
+(<*>) :: forall s a b . State s (a -> b) -> State s a -> State s b
+(<*>) sf sa = Control.Monad.State.Strict.do
+  f <- sf
+  a <- sa
+  Control.Monad.State.Strict.return (f a)
+
 modify :: forall s . (s -> s) -> State s ()
 modify f = S $ \ s -> ((), f s)
 
--- a/src/MicroHs/TCMonad.hs
+++ b/src/MicroHs/TCMonad.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -Wno-orphans -Wno-dodgy-imports -Wno-unused-imports #-}
 module MicroHs.TCMonad(
   TC, tcRun,
-  fmap, (<$>),
+  fmap, (<$>), (<*>),
   (>>=), (>>), return, fail,
   get, put, gets,
   mapM, mapM_,
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -738,14 +738,14 @@
     Type    lhs    t -> Type    lhs   <$> withVars (snd lhs) (tcInferTypeT t)
     Sign    i      t -> (Sign    i  ) <$> tcTypeT (Check kType) t
     ForImp  ie i   t -> (ForImp ie i) <$> tcTypeT (Check kType) t
-    Class   mc lhs m -> withVars (snd lhs) $ Class <$> tcCtx mc <*> pure lhs <*> mapM tcMethod m
-    Instance vs mc t m -> withVars vs $ Instance vs <$> tcCtx mc <*> tcTypeT (Check kConstraint) t <*> pure m
+    Class   mc lhs m -> withVars (snd lhs) $ Class <$> tcCtx mc T.<*> T.return lhs T.<*> T.mapM tcMethod m
+    Instance vs mc t m -> withVars vs $ Instance vs <$> tcCtx mc T.<*> tcTypeT (Check kConstraint) t T.<*> T.return m
     _                -> T.return d
  where
-   tcCtx Nothing  = pure Nothing
+   tcCtx Nothing  = T.return Nothing
    tcCtx (Just c) = Just <$> tcTypeT (Check kConstraint) c
    tcMethod (BSign i t) = BSign i <$> tcTypeT (Check kType) t
-   tcMethod m = pure m
+   tcMethod m = T.return m
 
 withVars :: forall a . [IdKind] -> T a -> T a
 withVars aiks ta =
-- 
⑨