shithub: MicroHs

Download patch

ref: 840f1dc788be933c4bd2a526240d8504bbb0d89f
parent: ddb7571fda33f7d26cf95ac8c0b3ad99bf89607d
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Thu Oct 26 10:30:51 EDT 2023 

Handle forall differently fo tcEqns


--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1122
-((A :0 _945) ((A :1 ((B _991) _0)) ((A :2 (((S' _991) _0) I)) ((A :3 _915) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _944) ((C _84) _5))) ((A :7 (((C' _6) (_962 _73)) ((_84 _960) _72))) ((A :8 ((B ((S _991) _960)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_84 _210)) _10)) ((A :12 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_82 _9)) P)) ((A :15 ((B (B (_82 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_82 _9)) (B (P _873)))) ((A :19 ((B (_82 _9)) (BK (P _873)))) ((A :20 ((_82 _9) ((S P) I))) ((A :21 ((B (_82 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _122)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _123)))))) ((A :23 ((B Y) ((B (B (P (_14 _873)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _873))) ((A :26 (_22 _85)) ((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 ((_76 _909) _910)) ((A :36 ((_76 _919) (_80 _36))) ((A :37 _920) ((A :38 _921) ((A :39 (((S' _28) (_912 #97)) ((C _912) #122))) ((A :40 (((S' _28) (_912 #65)) ((C _912) #90))) ((A :41 (((S' _27) _39) _40)) ((A :42 (((S' _28) (_912 #48)) ((C _912) #57))) ((A :43 (((S' _28) (_912 #32)) ((C _912) #126))) ((A :44 _909) ((A :45 _910) ((A :46 _912) ((A :47 _911) ((A :48 (((S' _27) ((C (_77 _35)) #32)) (((S' _27) ((C (_77 _35)) #9)) ((C (_77 _35)) #10)))) ((A :49 ((S ((S (((S' _28) (_46 #65)) ((C _46) #90))) (_34 (((_872 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #65))) (_38 #97))))) ((A :50 ((S ((S (((S' _28) (_46 #97)) ((C _46) #97))) (_34 (((_872 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #97))) (_38 #65))))) ((A :51 _880) ((A :52 _881) ((A :53 _882) ((A :54 _883) ((A :55 (_52 %0.0)) ((A :56 _51) ((A :57 _52) ((A :58 _53) ((A :59 _54) ((A :60 ((_76 _884) _885)) ((A :61 (_77 _60)) ((A :62 (_78 _60)) ((A :63 _886) ((A :64 _887) ((A :65 _888) ((A :66 _889) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _66) ((A :71 _890) ((A :72 ((B BK) T)) ((A :73 (BK T)) ((A :74 (((S' _76) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _77) (T K)))) (K _33)))) ((B ((C' B) (T (K _33)))) ((B _77) (T A))))) ((B _80) ((B _74) (((S' P) (T K)) (T A)))))) ((A :75 P) ((A :76 P) ((A :77 (T K)) ((A :78 (T A)) ((A :79 (K (noDefault "Eq.=="))) ((A :80 ((B (B (B _29))) _77)) ((A :81 ((_76 ((C ((C S') _29)) I)) (_80 _81))) ((A :82 I) ((A :83 (S _917)) ((A :84 B) ((A :85 I) ((A :86 K) ((A :87 C) ((A :88 _916) ((A :89 ((C ((C S') _210)) _211)) ((A :90 (((C' (S' (C' B))) B) I)) ((A :91 _874) ((A :92 _875) ((A :93 _876) ((A :94 _877) ((A :95 _878) ((A :96 _879) ((A :97 (_92 #0)) ((A :98 ((_76 _897) _898)) ((A :99 _899) ((A :100 _900) ((A :101 _901) ((A :102 _902) ((A :103 (BK K)) ((A :104 ((B BK) ((B (B BK)) P))) ((A :105 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :106 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_100 #0))) ((C (_77 _98)) #0)))) ((B (B ((C' P) (_96 #1)))) _91))) (C P))) _94)) _95)) ((A :107 _103) ((A :108 (((S' C) ((B (P _197)) (((C' (C' B)) (((C' C) (_77 _98)) _197)) _198))) ((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') ((C (_77 _98)) #0))))) ((B ((C' (C' C)) ((B (B ((S' S') ((C (_77 _98)) #1)))) ((B ((C' C) ((B ((C' S') ((C (_77 _98)) #2))) (C _108)))) (C _108))))) (C _108))))) (C _108)))) (T K))) (T A)))) ((C _106) #4)))) ((A :109 (_115 _86)) ((A :110 ((_131 (_89 _109)) _107)) ((A :111 ((C (((C' B) ((P _122) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _112)))) (((S' (C' (C' B))) ((B (B (B _112))) (((S' (C' B)) ((B (B _112)) (((C' B) ((B _129) (T #0))) _111))) (((C' B) ((B _129) (T #1))) _111)))) (((C' B) ((B _129) (T #2))) _111)))) (((C' B) ((B _129) (T #3))) _111)))) ((B T) ((B (B P)) ((C' _91) (_93 #4)))))) ((A :112 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C') 
\ No newline at end of file
+1121
+((A :0 _944) ((A :1 ((B _990) _0)) ((A :2 (((S' _990) _0) I)) ((A :3 _914) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _943) ((C _84) _5))) ((A :7 (((C' _6) (_961 _73)) ((_84 _959) _72))) ((A :8 ((B ((S _990) _959)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_84 _210)) _10)) ((A :12 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_82 _9)) P)) ((A :15 ((B (B (_82 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_82 _9)) (B (P _872)))) ((A :19 ((B (_82 _9)) (BK (P _872)))) ((A :20 ((_82 _9) ((S P) I))) ((A :21 ((B (_82 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _122)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _123)))))) ((A :23 ((B Y) ((B (B (P (_14 _872)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _872))) ((A :26 (_22 _85)) ((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 ((_76 _908) _909)) ((A :36 ((_76 _918) (_80 _36))) ((A :37 _919) ((A :38 _920) ((A :39 (((S' _28) (_911 #97)) ((C _911) #122))) ((A :40 (((S' _28) (_911 #65)) ((C _911) #90))) ((A :41 (((S' _27) _39) _40)) ((A :42 (((S' _28) (_911 #48)) ((C _911) #57))) ((A :43 (((S' _28) (_911 #32)) ((C _911) #126))) ((A :44 _908) ((A :45 _909) ((A :46 _911) ((A :47 _910) ((A :48 (((S' _27) ((C (_77 _35)) #32)) (((S' _27) ((C (_77 _35)) #9)) ((C (_77 _35)) #10)))) ((A :49 ((S ((S (((S' _28) (_46 #65)) ((C _46) #90))) (_34 (((_871 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #65))) (_38 #97))))) ((A :50 ((S ((S (((S' _28) (_46 #97)) ((C _46) #97))) (_34 (((_871 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #97))) (_38 #65))))) ((A :51 _879) ((A :52 _880) ((A :53 _881) ((A :54 _882) ((A :55 (_52 %0.0)) ((A :56 _51) ((A :57 _52) ((A :58 _53) ((A :59 _54) ((A :60 ((_76 _883) _884)) ((A :61 (_77 _60)) ((A :62 (_78 _60)) ((A :63 _885) ((A :64 _886) ((A :65 _887) ((A :66 _888) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _66) ((A :71 _889) ((A :72 ((B BK) T)) ((A :73 (BK T)) ((A :74 (((S' _76) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _77) (T K)))) (K _33)))) ((B ((C' B) (T (K _33)))) ((B _77) (T A))))) ((B _80) ((B _74) (((S' P) (T K)) (T A)))))) ((A :75 P) ((A :76 P) ((A :77 (T K)) ((A :78 (T A)) ((A :79 (K (noDefault "Eq.=="))) ((A :80 ((B (B (B _29))) _77)) ((A :81 ((_76 ((C ((C S') _29)) I)) (_80 _81))) ((A :82 I) ((A :83 (S _916)) ((A :84 B) ((A :85 I) ((A :86 K) ((A :87 C) ((A :88 _915) ((A :89 ((C ((C S') _210)) _211)) ((A :90 (((C' (S' (C' B))) B) I)) ((A :91 _873) ((A :92 _874) ((A :93 _875) ((A :94 _876) ((A :95 _877) ((A :96 _878) ((A :97 (_92 #0)) ((A :98 ((_76 _896) _897)) ((A :99 _898) ((A :100 _899) ((A :101 _900) ((A :102 _901) ((A :103 (BK K)) ((A :104 ((B BK) ((B (B BK)) P))) ((A :105 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :106 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_100 #0))) ((C (_77 _98)) #0)))) ((B (B ((C' P) (_96 #1)))) _91))) (C P))) _94)) _95)) ((A :107 _103) ((A :108 (((S' C) ((B (P _197)) (((C' (C' B)) (((C' C) (_77 _98)) _197)) _198))) ((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') ((C (_77 _98)) #0))))) ((B ((C' (C' C)) ((B (B ((S' S') ((C (_77 _98)) #1)))) ((B ((C' C) ((B ((C' S') ((C (_77 _98)) #2))) (C _108)))) (C _108))))) (C _108))))) (C _108)))) (T K))) (T A)))) ((C _106) #4)))) ((A :109 (_115 _86)) ((A :110 ((_131 (_89 _109)) _107)) ((A :111 ((C (((C' B) ((P _122) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _112)))) (((S' (C' (C' B))) ((B (B (B _112))) (((S' (C' B)) ((B (B _112)) (((C' B) ((B _129) (T #0))) _111))) (((C' B) ((B _129) (T #1))) _111)))) (((C' B) ((B _129) (T #2))) _111)))) (((C' B) ((B _129) (T #3))) _111)))) ((B T) ((B (B P)) ((C' _91) (_93 #4)))))) ((A :112 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C') 
\ No newline at end of file
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -1172,9 +1172,11 @@
 mkClassConstructor :: Ident -> Ident
 mkClassConstructor i = addIdentSuffix i "$C"
 
+{-
 unForall :: EType -> ([IdKind], EType)
 unForall (EForall iks t) = (iks, t)
 unForall t = ([], t)
+-}
 
 tcDefValue :: --XHasCallStack =>
               EDef -> T EDef
@@ -1182,10 +1184,9 @@
   case adef of
     Fcn i eqns -> T.do
       (_, tt) <- tLookup "no type signature" "many type signatures" i
-      let (iks, tfn) = unForall tt
 --      traceM $ "tcDefValue: " ++ showIdent i ++ " :: " ++ showExpr tt
       mn <- gets moduleName
-      teqns <- withExtTyps iks $ tcEqns tfn eqns
+      teqns <- tcEqns tt eqns
 --      traceM (showEDefs [Fcn i eqns, Fcn i teqns])
       checkConstraints
       T.return $ Fcn (qualIdent mn i) teqns
@@ -1551,6 +1552,7 @@
 
 tcEqns :: EType -> [Eqn] -> T [Eqn]
 --tcEqns t eqns | trace ("tcEqns: " ++ showEBind (BFcn dummyIdent eqns) ++ " :: " ++ showEType t) False = undefined
+tcEqns (EForall iks t) eqns = withExtTyps iks $ tcEqns t eqns
 tcEqns t eqns | Just (ctx, t') <- getImplies t = T.do
   let loc = getSLocEqns eqns
   d <- newIdent loc "adict"
@@ -1575,6 +1577,7 @@
       T.return [eqn]
 
 tcEqn :: EType -> Eqn -> T Eqn
+--tcEqn t _eqn | trace ("tcEqn: " ++ showEType t) False = undefined
 tcEqn t eqn =
   case eqn of
     Eqn ps alts -> tcPats t ps $ \ tt ps' -> T.do
@@ -1586,7 +1589,7 @@
   tcBinds bs $ \ bbs -> T.do { aalts <- T.mapM (tcAlt tt) alts; T.return (EAlts aalts bbs) }
 
 tcAlt :: EType -> EAlt -> T EAlt
---tcAlt t _ | trace ("tcAlt: " ++ showExpr t) False = undefined
+--tcAlt t (_, rhs) | trace ("tcAlt: " ++ showExpr rhs ++ " :: " ++ showEType t) False = undefined
 tcAlt t (ss, rhs) = tcGuards ss $ \ sss -> T.do { rrhs <- tCheckExpr t rhs; T.return (sss, rrhs) }
 
 tcGuards :: forall a . [EStmt] -> ([EStmt] -> T a) -> T a
@@ -1701,8 +1704,7 @@
   case abind of
     BFcn i eqns -> T.do
       (_, tt) <- tLookupV i
-      let (iks, tfn) = unForall tt
-      teqns <- withExtTyps iks $ tcEqns tfn eqns
+      teqns <- tcEqns tt eqns
       T.return $ BFcn i teqns
     BPat p a -> T.do
       (ep, tp) <- withTCMode TCPat $ tInferExpr p  -- pattern variables already bound
-- 
⑨