shithub: MicroHs

Download patch

ref: e092937fb9ffd660d8b3717226ac2c81313556b0
parent: c5052bb7882174ed1fe11da99dbbe9facb45bcb3
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Sat Oct 21 09:34:30 EDT 2023

Limit constraint solving to locally generated constraints.

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1093
-((A :0 _916) ((A :1 ((B _962) _0)) ((A :2 (((S' _962) _0) I)) ((A :3 _886) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _915) ((C _76) _5))) ((A :7 (((C' _6) (_933 _72)) ((_76 _931) _71))) ((A :8 ((B ((S _962) _931)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_76 _192)) _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 _844)))) ((A :19 ((B (_74 _9)) (BK (P _844)))) ((A :20 ((_74 _9) ((S P) I))) ((A :21 ((B (_74 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _116)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _117)))))) ((A :23 ((B Y) ((B (B (P (_14 _844)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _844))) ((A :26 (_22 _77)) ((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 _891) ((A :36 _892) ((A :37 (((S' _28) (_883 #97)) ((C _883) #122))) ((A :38 (((S' _28) (_883 #65)) ((C _883) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_883 #48)) ((C _883) #57))) ((A :41 (((S' _28) (_883 #32)) ((C _883) #126))) ((A :42 _880) ((A :43 _881) ((A :44 _883) ((A :45 _882) ((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 (((_842 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _83) (((C' _84) _36) (_36 #65))) (_36 #97))))) ((A :48 ((S ((S (((S' _28) (_44 #97)) ((C _44) #97))) (_34 (((_842 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _83) (((C' _84) _36) (_36 #97))) (_36 #65))))) ((A :49 _851) ((A :50 _852) ((A :51 _853) ((A :52 _854) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _855) ((A :59 _856) ((A :60 _58) ((A :61 _59) ((A :62 _857) ((A :63 _858) ((A :64 _859) ((A :65 _860) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _861) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 I) ((A :75 (S _888)) ((A :76 B) ((A :77 I) ((A :78 K) ((A :79 C) ((A :80 _887) ((A :81 ((C ((C S') _192)) _193)) ((A :82 (((C' (S' (C' B))) B) I)) ((A :83 _845) ((A :84 _846) ((A :85 _847) ((A :86 _848) ((A :87 _849) ((A :88 _850) ((A :89 (_84 #0)) ((A :90 _868) ((A :91 _869) ((A :92 _870) ((A :93 _871) ((A :94 _872) ((A :95 _873) ((A :96 _90) ((A :97 (BK K)) ((A :98 ((B BK) ((B (B BK)) P))) ((A :99 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :100 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_93 #0))) (_90 #0)))) ((B (B ((C' P) (_88 #1)))) _83))) (C P))) _86)) _87)) ((A :101 _97) ((A :102 (((S' C) ((B (P _180)) (((C' (C' B)) (((C' C) _90) _180)) _181))) ((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') (_90 #0))))) ((B ((C' (C' C)) ((B (B ((S' S') (_90 #1)))) ((B ((C' C) ((B ((C' S') (_90 #2))) (C _102)))) (C _102))))) (C _102))))) (C _102)))) (T K))) (T A)))) ((C _100) #4)))) ((A :103 (_109 _78)) ((A :104 ((_124 (_81 _103)) _101)) ((A :105 ((C (((C' B) ((P _116) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _106)))) (((S' (C' (C' B))) ((B (B (B _106))) (((S' (C' B)) ((B (B _106)) (((C' B) ((B _122) (T #0))) _105))) (((C' B) ((B _122) (T #1))) _105)))) (((C' B) ((B _122) (T #2))) _105)))) (((C' B) ((B _122) (T #3))) _105)))) ((B T) ((B (B P)) ((C' _83) (_85 #4)))))) ((A :106 ((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) _92)))) ((B ((C' B) _117)) _106)))))) ((B ((C' B) _117)) (C _106)))))))))) (((_842 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :107 ((_76 (_122 _192)) _105)) ((A :108 (((C' C) (((C' C) (C _102)) (_3 "Data.IntMap.!"))) I)) ((A :109 ((B (C' Y)) (((C' (C' (S' (S' C)))
\ No newline at end of file
+1094
+((A :0 _917) ((A :1 ((B _963) _0)) ((A :2 (((S' _963) _0) I)) ((A :3 _887) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _916) ((C _76) _5))) ((A :7 (((C' _6) (_934 _72)) ((_76 _932) _71))) ((A :8 ((B ((S _963) _932)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_76 _192)) _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 _845)))) ((A :19 ((B (_74 _9)) (BK (P _845)))) ((A :20 ((_74 _9) ((S P) I))) ((A :21 ((B (_74 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _116)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _117)))))) ((A :23 ((B Y) ((B (B (P (_14 _845)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _845))) ((A :26 (_22 _77)) ((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 _892) ((A :36 _893) ((A :37 (((S' _28) (_884 #97)) ((C _884) #122))) ((A :38 (((S' _28) (_884 #65)) ((C _884) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_884 #48)) ((C _884) #57))) ((A :41 (((S' _28) (_884 #32)) ((C _884) #126))) ((A :42 _881) ((A :43 _882) ((A :44 _884) ((A :45 _883) ((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 (((_843 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _83) (((C' _84) _36) (_36 #65))) (_36 #97))))) ((A :48 ((S ((S (((S' _28) (_44 #97)) ((C _44) #97))) (_34 (((_843 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _83) (((C' _84) _36) (_36 #97))) (_36 #65))))) ((A :49 _852) ((A :50 _853) ((A :51 _854) ((A :52 _855) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _856) ((A :59 _857) ((A :60 _58) ((A :61 _59) ((A :62 _858) ((A :63 _859) ((A :64 _860) ((A :65 _861) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _862) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 I) ((A :75 (S _889)) ((A :76 B) ((A :77 I) ((A :78 K) ((A :79 C) ((A :80 _888) ((A :81 ((C ((C S') _192)) _193)) ((A :82 (((C' (S' (C' B))) B) I)) ((A :83 _846) ((A :84 _847) ((A :85 _848) ((A :86 _849) ((A :87 _850) ((A :88 _851) ((A :89 (_84 #0)) ((A :90 _869) ((A :91 _870) ((A :92 _871) ((A :93 _872) ((A :94 _873) ((A :95 _874) ((A :96 _90) ((A :97 (BK K)) ((A :98 ((B BK) ((B (B BK)) P))) ((A :99 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :100 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_93 #0))) (_90 #0)))) ((B (B ((C' P) (_88 #1)))) _83))) (C P))) _86)) _87)) ((A :101 _97) ((A :102 (((S' C) ((B (P _180)) (((C' (C' B)) (((C' C) _90) _180)) _181))) ((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') (_90 #0))))) ((B ((C' (C' C)) ((B (B ((S' S') (_90 #1)))) ((B ((C' C) ((B ((C' S') (_90 #2))) (C _102)))) (C _102))))) (C _102))))) (C _102)))) (T K))) (T A)))) ((C _100) #4)))) ((A :103 (_109 _78)) ((A :104 ((_124 (_81 _103)) _101)) ((A :105 ((C (((C' B) ((P _116) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _106)))) (((S' (C' (C' B))) ((B (B (B _106))) (((S' (C' B)) ((B (B _106)) (((C' B) ((B _122) (T #0))) _105))) (((C' B) ((B _122) (T #1))) _105)))) (((C' B) ((B _122) (T #2))) _105)))) (((C' B) ((B _122) (T #3))) _105)))) ((B T) ((B (B P)) ((C' _83) (_85 #4)))))) ((A :106 ((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) _92)))) ((B ((C' B) _117)) _106)))))) ((B ((C' B) _117)) (C _106)))))))))) (((_843 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :107 ((_76 (_122 _192)) _105)) ((A :108 (((C' C) (((C' C) (C _102)) (_3 "Data.IntMap.!"))) I)) ((A :109 ((B (C' Y)) (((C' (C' (S' (S' C)))
\ No newline at end of file
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -1524,8 +1524,7 @@
 tcEqns t eqns = T.do
   let loc = getSLocEqns eqns
   f <- newIdent loc "fcnS"
-  eqns' <- T.mapM (tcEqn t) eqns
-  ds <- solveConstraints
+  (eqns', ds) <- solveLocalConstraints $ T.mapM (tcEqn t) eqns
   case ds of
     [] -> T.return eqns'
     _  -> T.do
@@ -1891,6 +1890,20 @@
 
 mkSuperSel :: IdentModule -> Ident -> Int -> Ident
 mkSuperSel mn c i = qualIdent mn $ mkIdent $ unIdent c ++ "$super" ++ showInt i
+
+---------------------------------
+
+-- Solve constraints generated locally in 'ta'.
+-- Keep any unsolved ones for later.
+solveLocalConstraints :: forall a . T a -> T (a, [(Ident, Expr)])
+solveLocalConstraints ta = T.do
+  cs <- gets constraints           -- old constraints
+  putConstraints []                -- start empty
+  a <- ta                          -- compute, generating constraints
+  ds <- solveConstraints           -- solve those
+  un <- gets constraints           -- get remaining unsolved
+  putConstraints (un ++ cs)        -- put back unsolved and old constraints
+  T.return (a, ds)
 
 {-
 showInstDict :: InstDict -> String
--