shithub: MicroHs

Download patch

ref: 23004b0d63df15b92a5269d6e2709caeee63d25a
parent: 44a8af865a9603740b729818386fbf89eecee3c4
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Thu Oct 19 11:24:18 EDT 2023 

Some small improvements


--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
 1082
-((A :0 _966) ((A :1 ((B _1012) _0)) ((A :2 (((S' _1012) _0) I)) ((A :3 _936) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _965) ((C _76) _5))) ((A :7 (((C' _6) (_983 _72)) ((_76 _981) _71))) ((A :8 ((B ((S _1012) _981)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_76 _191)) _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 _894)))) ((A :19 ((B (_74 _9)) (BK (P _894)))) ((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 _894)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _894))) ((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 _941) ((A :36 _942) ((A :37 (((S' _28) (_933 #97)) ((C _933) #122))) ((A :38 (((S' _28) (_933 #65)) ((C _933) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_933 #48)) ((C _933) #57))) ((A :41 (((S' _28) (_933 #32)) ((C _933) #126))) ((A :42 _930) ((A :43 _931) ((A :44 _933) ((A :45 _932) ((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 (((_892 "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 (((_892 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _83) (((C' _84) _36) (_36 #97))) (_36 #65))))) ((A :49 _901) ((A :50 _902) ((A :51 _903) ((A :52 _904) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _905) ((A :59 _906) ((A :60 _58) ((A :61 _59) ((A :62 _907) ((A :63 _908) ((A :64 _909) ((A :65 _910) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _911) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 I) ((A :75 (S _938)) ((A :76 B) ((A :77 I) ((A :78 K) ((A :79 C) ((A :80 _937) ((A :81 ((C ((C S') _191)) _192)) ((A :82 (((C' (S' (C' B))) B) I)) ((A :83 _895) ((A :84 _896) ((A :85 _897) ((A :86 _898) ((A :87 _899) ((A :88 _900) ((A :89 (_84 #0)) ((A :90 _918) ((A :91 _919) ((A :92 _920) ((A :93 _921) ((A :94 _922) ((A :95 _923) ((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 _179)) (((C' (C' B)) (((C' C) _90) _179)) _180))) ((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)))))))))) (((_892 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :107 ((_76 (_122 _191)) _105)) ((A :108 (((C' C) (((C' C) (C _102)) (_3 "Data.IntMap.!"))) I)) ((A :109 ((B ((C' B) T)) ((B (B Y)) (((C
\ No newline at end of file
+((A :0 _966) ((A :1 ((B _1012) _0)) ((A :2 (((S' _1012) _0) I)) ((A :3 _936) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _965) ((C _76) _5))) ((A :7 (((C' _6) (_983 _72)) ((_76 _981) _71))) ((A :8 ((B ((S _1012) _981)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_76 _191)) _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 _894)))) ((A :19 ((B (_74 _9)) (BK (P _894)))) ((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 _894)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _894))) ((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 _941) ((A :36 _942) ((A :37 (((S' _28) (_933 #97)) ((C _933) #122))) ((A :38 (((S' _28) (_933 #65)) ((C _933) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_933 #48)) ((C _933) #57))) ((A :41 (((S' _28) (_933 #32)) ((C _933) #126))) ((A :42 _930) ((A :43 _931) ((A :44 _933) ((A :45 _932) ((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 (((_892 "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 (((_892 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _83) (((C' _84) _36) (_36 #97))) (_36 #65))))) ((A :49 _901) ((A :50 _902) ((A :51 _903) ((A :52 _904) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _905) ((A :59 _906) ((A :60 _58) ((A :61 _59) ((A :62 _907) ((A :63 _908) ((A :64 _909) ((A :65 _910) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _911) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 I) ((A :75 (S _938)) ((A :76 B) ((A :77 I) ((A :78 K) ((A :79 C) ((A :80 _937) ((A :81 ((C ((C S') _191)) _192)) ((A :82 (((C' (S' (C' B))) B) I)) ((A :83 _895) ((A :84 _896) ((A :85 _897) ((A :86 _898) ((A :87 _899) ((A :88 _900) ((A :89 (_84 #0)) ((A :90 _918) ((A :91 _919) ((A :92 _920) ((A :93 _921) ((A :94 _922) ((A :95 _923) ((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 _179)) (((C' (C' B)) (((C' C) _90) _179)) _180))) ((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)))))))))) (((_892 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :107 ((_76 (_122 _191)) _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/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -141,7 +141,8 @@
   in loop mvs asccs
 
 letE :: Ident -> Exp -> Exp -> Exp
-letE i e b = App (Lam i b) e
+letE i e b = eLet i e b          -- do some minor optimizations
+             --App (Lam i b) e
 
 letRecE :: Ident -> Exp -> Exp -> Exp
 letRecE i e b = letE i (App (Lit (LPrim "Y")) (Lam i e)) b
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -388,8 +388,8 @@
     ForImp ie i t -> text ("foreign import ccall " ++ showString ie) <+> ppIdent i <+> text "::" <+> ppEType t
     Infix (a, p) is -> text ("infix" ++ f a) <+> text (showInt p) <+> hsep (punctuate (text ", ") (map ppIdent is))
       where f AssocLeft = "l"; f AssocRight = "r"; f AssocNone = ""
-    Class sup lhs bs -> text "class" <+> ctx sup <+> ppLHS lhs <> ppWhere bs
-    Instance vs ct ty bs -> text "instance" <+> ppForall vs <+> ctx ct <+> ppEType ty <> ppWhere bs
+    Class sup lhs bs -> ppWhere (text "class" <+> ctx sup <+> ppLHS lhs) bs
+    Instance vs ct ty bs -> ppWhere (text "instance" <+> ppForall vs <+> ctx ct <+> ppEType ty) bs
  where ctx [] = empty
        ctx ts = ppEType (ETuple ts) <+> text "=>"
 
@@ -405,14 +405,15 @@
 ppIdKind (IdKind i k) = parens $ ppIdent i <> text "::" <> ppEKind k
 
 ppEDefs :: [EDef] -> Doc
-ppEDefs ds = vcat (map ppEDef ds)
+ppEDefs ds = vcat (map (nl . ppEDef) ds)
+  where nl d = d $+$ text ""
 
 ppAlts :: Doc -> EAlts -> Doc
-ppAlts asep (EAlts alts bs) = ppAltsL asep alts <> ppWhere bs
+ppAlts asep (EAlts alts bs) = ppWhere (ppAltsL asep alts) bs
 
-ppWhere :: [EBind] -> Doc
-ppWhere [] = empty
-ppWhere bs = text "where" $+$ nest 2 (vcat (map ppEBind bs))
+ppWhere :: Doc -> [EBind] -> Doc
+ppWhere d [] = d
+ppWhere d bs = (d <+> text "where") $+$ nest 2 (vcat (map ppEBind bs))
 
 ppAltsL :: Doc -> [EAlt] -> Doc
 ppAltsL asep [([], e)] = text "" <+> asep <+> ppExpr e
@@ -446,6 +447,7 @@
   where
     ppApp as (EApp f a) = ppApp (a:as) f
     ppApp as (EVar i) | eqString op "->", [a, b] <- as = parens $ ppExpr a <+> text "->" <+> ppExpr b
+                      | eqString op "=>", [a, b] <- as = parens $ ppExpr a <+> text "=>" <+> ppExpr b
                       | eqChar (head op) ',' = ppExpr (ETuple as)
                       | eqString op "[]", length as == 1 = ppExpr (EListish (LList as))
                         where op = unQualString (unIdent i)
--- a/src/MicroHs/Pretty.hs
+++ b/src/MicroHs/Pretty.hs
@@ -49,11 +49,9 @@
 hcat :: [Doc] -> Doc
 hcat = snd . reduceHoriz . foldr (\p q -> Beside p False q) empty
 
--- | List version of '<+>'.
 hsep :: [Doc] -> Doc
 hsep = snd . reduceHoriz . foldr (\p q -> Beside p True q)  empty
 
--- | List version of '$$'.
 vcat :: [Doc] -> Doc
 vcat = snd . reduceVert . foldr (\p q -> Above p False q) empty
 
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -1476,19 +1476,17 @@
 tcEqns t eqns | Just (ctx, t') <- getImplies t = T.do
   let loc = getSLocEqns eqns
   d <- newIdent loc "adict"
-  f <- newIdent loc "fcn"
+  f <- newIdent loc "fcnD"
   withDict (EVar d, [], [], ctx) $ T.do
     eqns' <- tcEqns t' eqns
-    ds <- solveConstraints
-    T.when (not (null ds)) impossible
-    let
-      -- XXX special case if eqns' is [Eqn [] ...] to avoid new binding
-      bs = eBinds ds
-      eqn = Eqn [EVar d] $ EAlts [([], EVar f)] (bs ++ [BFcn f eqns'])
+    let eqn =
+          case eqns' of
+            [Eqn [] alts] -> Eqn [EVar d] alts
+            _             -> Eqn [EVar d] $ EAlts [([], EVar f)] [BFcn f eqns']
     T.return [eqn]
 tcEqns t eqns = T.do
   let loc = getSLocEqns eqns
-  f <- newIdent loc "fcn"
+  f <- newIdent loc "fcnS"
   eqns' <- T.mapM (tcEqn t) eqns
   ds <- solveConstraints
   case ds of
-- 
⑨