shithub: MicroHs

Download patch

ref: b88a5574826a0e91827318a259b3bd05140cd128
parent: 8c4dce898adb8be8ca462ed6886bac3263b62180
author: Lennart Augustsson <lennart@augustsson.net>
date: Tue Oct 10 18:33:37 EDT 2023

Fix bug.

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v3.5
-968
-(($A :0 _852) (($A :1 (($B _898) _0)) (($A :2 ((($S' _898) _0) $I)) (($A :3 _822) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _851) (($C _74) _5))) (($A :7 ((($C' _6) (_869 _71)) ((_74 _867) _70))) (($A :8 (($B (($S _898) _867)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_74 _188)) _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 _780)))) (($A :18 (($B (_73 _9)) ($BK ($P _780)))) (($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 _780)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _780))) (($A :25 (_21 _75)) (($A :26 (($C $C) _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 _827) (($A :35 _828) (($A :36 ((($S' _27) (_819 97)) (($C _819) 122))) (($A :37 ((($S' _27) (_819 65)) (($C _819) 90))) (($A :38 ((($S' _26) _36) _37)) (($A :39 ((($S' _27) (_819 48)) (($C _819) 57))) (($A :40 ((($S' _27) (_819 32)) (($C _819) 126))) (($A :41 _816) (($A :42 _817) (($A :43 _819) (($A :44 _818) (($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 (((_779 "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 (((_779 "lib/Data/Char.hs") 3) 8)))) (($B _34) ((($C' _81) ((($C' _82) _35) (_35 97))) (_35 65))))) (($A :48 _787) (($A :49 _788) (($A :50 _789) (($A :51 _790) (($A :52 (_49 %0.0)) (($A :53 _48) (($A :54 _49) (($A :55 _50) (($A :56 _51) (($A :57 _791) (($A :58 _792) (($A :59 _57) (($A :60 _58) (($A :61 _793) (($A :62 _794) (($A :63 _795) (($A :64 _796) (($A :65 _61) (($A :66 _62) (($A :67 _63) (($A :68 _64) (($A :69 _797) (($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 _823) (($A :79 (($C (($C $S') _188)) _189)) (($A :80 ((($C' ($S' ($C' $B))) $B) $I)) (($A :81 _781) (($A :82 _782) (($A :83 _783) (($A :84 _784) (($A :85 _785) (($A :86 _786) (($A :87 (_82 0)) (($A :88 _804) (($A :89 _805) (($A :90 _806) (($A :91 _807) (($A :92 _808) (($A :93 _809) (($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 _176)) ((($C' ($C' $B)) ((($C' $C) _88) _176)) _177))) (($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 (
\ No newline at end of file
+969
+(($A :0 _853) (($A :1 (($B _899) _0)) (($A :2 ((($S' _899) _0) $I)) (($A :3 _823) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _852) (($C _74) _5))) (($A :7 ((($C' _6) (_870 _71)) ((_74 _868) _70))) (($A :8 (($B (($S _899) _868)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_74 _188)) _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 _781)))) (($A :18 (($B (_73 _9)) ($BK ($P _781)))) (($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 _781)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _781))) (($A :25 (_21 _75)) (($A :26 (($C $C) _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 _828) (($A :35 _829) (($A :36 ((($S' _27) (_820 97)) (($C _820) 122))) (($A :37 ((($S' _27) (_820 65)) (($C _820) 90))) (($A :38 ((($S' _26) _36) _37)) (($A :39 ((($S' _27) (_820 48)) (($C _820) 57))) (($A :40 ((($S' _27) (_820 32)) (($C _820) 126))) (($A :41 _817) (($A :42 _818) (($A :43 _820) (($A :44 _819) (($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 (((_780 "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 (((_780 "lib/Data/Char.hs") 3) 8)))) (($B _34) ((($C' _81) ((($C' _82) _35) (_35 97))) (_35 65))))) (($A :48 _788) (($A :49 _789) (($A :50 _790) (($A :51 _791) (($A :52 (_49 %0.0)) (($A :53 _48) (($A :54 _49) (($A :55 _50) (($A :56 _51) (($A :57 _792) (($A :58 _793) (($A :59 _57) (($A :60 _58) (($A :61 _794) (($A :62 _795) (($A :63 _796) (($A :64 _797) (($A :65 _61) (($A :66 _62) (($A :67 _63) (($A :68 _64) (($A :69 _798) (($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 _824) (($A :79 (($C (($C $S') _188)) _189)) (($A :80 ((($C' ($S' ($C' $B))) $B) $I)) (($A :81 _782) (($A :82 _783) (($A :83 _784) (($A :84 _785) (($A :85 _786) (($A :86 _787) (($A :87 (_82 0)) (($A :88 _805) (($A :89 _806) (($A :90 _807) (($A :91 _808) (($A :92 _809) (($A :93 _810) (($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 _176)) ((($C' ($C' $B)) ((($C' $C) _88) _176)) _177))) (($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 (
\ No newline at end of file
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -179,7 +179,8 @@
 isPConApp _ = True
 
 patVars :: EPat -> [Ident]
-patVars = filter (not . isConIdent) . allVarsExpr
+patVars = filter isVar . allVarsExpr
+  where isVar v = not (isConIdent v) && not (isDummyIdent v)
 
 type LHS = (Ident, [IdKind])
 
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -6,6 +6,7 @@
   mkIdent, mkIdentLoc, unIdent, eqIdent, leIdent, qualIdent, showIdent, getSLocIdent, setSLocIdent,
   mkIdentSLoc,
   isLower_, isIdentChar, isOperChar, isConIdent,
+  isDummyIdent,
   unQualString,
   SLoc(..), noSLoc, isNoSLoc,
   showSLoc,
@@ -87,6 +88,10 @@
 
 isLower_ :: Char -> Bool
 isLower_ c = isLower c || eqChar c '_'
+
+isDummyIdent :: Ident -> Bool
+isDummyIdent (Ident _ "_") = True
+isDummyIdent _ = False
 
 showSLoc :: SLoc -> String
 showSLoc (SLoc fn l c) =
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -877,7 +877,7 @@
     EVar i -> T.do
       tcm <- gets tcMode
       case tcm of
-        TCPat | isUnderscore i -> T.do
+        TCPat | isDummyIdent i -> T.do
                 -- _ can be anything, so just ignore it
                 _ <- tGetExpTypeSet mt
                 T.return ae
@@ -902,7 +902,7 @@
           
         _ -> T.do
           -- Type checking an expression (or type)
-          T.when (isUnderscore i) impossible
+          T.when (isDummyIdent i) impossible
           (e, t) <- tLookup "variable" i
           -- Variables bound in patterns start with an (EUVar ref) type,
           -- which can be instantiated to a polytype.
@@ -1182,7 +1182,7 @@
   withExtVals [(v, t)] $ ta p
 tCheckPat t ap ta = T.do
 --  traceM $ "tcPat: " ++ show ap
-  let vs = filter (not . isUnderscore) $ patVars ap
+  let vs = patVars ap
   multCheck vs
   env <- T.mapM (\ v -> (v,) <$> newUVar) vs
   withExtVals env $ T.do
@@ -1297,9 +1297,6 @@
 showTModule sh amdl =
   case amdl of
     TModule mn _ _ _ _ a -> "Tmodule " ++ showIdent mn ++ "\n" ++ sh a
-
-isUnderscore :: Ident -> Bool
-isUnderscore = eqString "_" . unIdent
 
 {-
 showValueTable :: ValueTable -> String
--