ref: d424eefdba84b1a31e7c608859afb0b8b484bb63
parent: dd6d15f672fd622dbca510bd562d66c629bca6a3
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Wed Sep 20 07:27:52 EDT 2023
Allow TupleSections of pairs.
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
OUTDIR=ghc-out
TOOLS=Tools
PROF= #-prof -fprof-auto
-EXTS= -XScopedTypeVariables -XQualifiedDo
+EXTS= -XScopedTypeVariables -XQualifiedDo -XTupleSections
GHCB=ghc $(PROF) -outputdir $(BOOTDIR)
GHCFLAGS=-i -ighc -ilib -i$(BOOTDIR) -hide-all-packages -XNoImplicitPrelude $(EXTS) -F -pgmF $(TOOLS)/convertY.sh
GHCC=$(GHCB) $(GHCFLAGS)
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.4
-850
-(($A :0 ((_645 _594) (($B ((($S' ($C ((($C' ($S' _645)) (($B ($C _2)) _577)) (($B ($B (_645 _674))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _646)) ((($C' $B) (($B _743) (($B _664) ((($C' _779) _9) 0)))) (($B (_743 _667)) (($B (_680 "top level defns: ")) _625)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _646)) ((($C' $B) (($B _743) (($B _664) ((($C' _779) _9) 1)))) (_663 ($T (($B ($B (_743 _667))) ((($C' $B) (($B _680) ((($C' _680) _583) " = "))) (($C _402) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _10))) ((($S' $B) (($B ($C' ($C' _646))) ((($C' $B) ($B' (($B _743) (($B _669) _12)))) (($B _680) ((($C' _680) (($B (_680 _1)) _625)) (($O 10) $K)))))) (($B ($B (_645 _674))) ((($C' $B) ($B' (($B _743) (($B _664) ((($C' _779) _9) 0))))) (($B ($B (_743 _667))) ((($C' ($C' _680)) (($B ($B (_680 "final pass "))) (($B ($B (_639 6))) (($B ($B _625)) _773)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _685)) _402))) (($C _698) (_714 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _744) (($B _680) ((($C' _680) (($B (_680 "(($A :")) _625)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _744)) ($B _402))) (($B (_744 (_680 ") "))) (($C _744) (_680 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _377)) $I))) ($BK $K))) $K))))) (($B (($S' _743) (($B _740) (($B (_743 _788)) (($B (_680 "main: findIdent: ")) _583))))) (($C' _613) _580)))) _620))) (($B ($B _617)) ((($C' $B) (($B _682) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _580))) $K)))))) (($C _698) (_714 0))))))) ($T $A))) ($T $K))) $I)) (($B (_743 _376)) (($B (_743 _577)) (($B (_680 (($O 95) $K))) _625)))))))) (($S (($S ((($S' _8) (($B _697) (_684 (_637 "-v")))) ((_713 _637) "-r"))) (($B (_678 (($O 46) $K))) (($B _742) (_683 ((_702 _764) "-i")))))) (($B (_743 _709)) ((($C' _680) (($B _742) (_683 ((_702 _764) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _775) _697) 1)) (_788 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _709)) (_684 ((_744 _784) ((_744 (_637 (($O 45) $K))) (_695 1))))))) (_705 ((_744 _784) (_637 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _645)) _17) (($B ($B ($B (_645 _674)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _645) (($B _647) (_736 _222)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_645 _674))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _646))) ((($C' $B) ($B' (($B _743) (($B _664) ((($C' _779) _9) 0))))) (($B ($B (_743 _667))) ((($C' ($C' _680)) (($B ($B (_680 "combinator conversion "))) (($B ($B (_639 6))) (($B ($B _625)) _773)))) "ms")))))) (($B ($B _647)) (($B $P) (($C _586) (_577 "main"))))))))) (_682 ($T ((($C' ($C' $O)) ((($C' $B) $P) _405)) $K))))))) (($A :3 (($B (_645 _594)) (($B (($C' _595) ((($C' _768) (($B _697) (_705 ((_744 _784) (_637 "--"))))) 1))) (($B (_743 _7)) _4)))) (($A :4 ($T (($C ((($C' $C') (($B $S) ($C $C))) (($B ($B $Y)) (($B ($B ($B _567))) (($C' ($C' _682)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _5))) $K))))))) (($B (($S' _743) (($B _740) (($B (_743 _788)) (($B (_680 "not found ")) _583))))) ($C _568))))) (($A :5 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _7)) _5)) _5))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _7)) $K))) ((($C' $B) _5) _404))) ((($S' _743) (($B _740) (($B (_743 _788)) (_680 "primlookup: ")))) (($C (_719 _637)) _6)))) $K))) (_788 "trans: impossible"))) (($A :6 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67)
\ No newline at end of file
+851
+(($A :0 ((_646 _595) (($B ((($S' ($C ((($C' ($S' _646)) (($B ($C _2)) _578)) (($B ($B (_646 _675))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _647)) ((($C' $B) (($B _744) (($B _665) ((($C' _780) _9) 0)))) (($B (_744 _668)) (($B (_681 "top level defns: ")) _626)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _647)) ((($C' $B) (($B _744) (($B _665) ((($C' _780) _9) 1)))) (_664 ($T (($B ($B (_744 _668))) ((($C' $B) (($B _681) ((($C' _681) _584) " = "))) (($C _403) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _10))) ((($S' $B) (($B ($C' ($C' _647))) ((($C' $B) ($B' (($B _744) (($B _670) _12)))) (($B _681) ((($C' _681) (($B (_681 _1)) _626)) (($O 10) $K)))))) (($B ($B (_646 _675))) ((($C' $B) ($B' (($B _744) (($B _665) ((($C' _780) _9) 0))))) (($B ($B (_744 _668))) ((($C' ($C' _681)) (($B ($B (_681 "final pass "))) (($B ($B (_640 6))) (($B ($B _626)) _774)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _686)) _403))) (($C _699) (_715 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _745) (($B _681) ((($C' _681) (($B (_681 "(($A :")) _626)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _745)) ($B _403))) (($B (_745 (_681 ") "))) (($C _745) (_681 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _378)) $I))) ($BK $K))) $K))))) (($B (($S' _744) (($B _741) (($B (_744 _789)) (($B (_681 "main: findIdent: ")) _584))))) (($C' _614) _581)))) _621))) (($B ($B _618)) ((($C' $B) (($B _683) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _581))) $K)))))) (($C _699) (_715 0))))))) ($T $A))) ($T $K))) $I)) (($B (_744 _377)) (($B (_744 _578)) (($B (_681 (($O 95) $K))) _626)))))))) (($S (($S ((($S' _8) (($B _698) (_685 (_638 "-v")))) ((_714 _638) "-r"))) (($B (_679 (($O 46) $K))) (($B _743) (_684 ((_703 _765) "-i")))))) (($B (_744 _710)) ((($C' _681) (($B _743) (_684 ((_703 _765) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _776) _698) 1)) (_789 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _710)) (_685 ((_745 _785) ((_745 (_638 (($O 45) $K))) (_696 1))))))) (_706 ((_745 _785) (_638 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _646)) _17) (($B ($B ($B (_646 _675)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _646) (($B _648) (_737 _223)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_646 _675))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _647))) ((($C' $B) ($B' (($B _744) (($B _665) ((($C' _780) _9) 0))))) (($B ($B (_744 _668))) ((($C' ($C' _681)) (($B ($B (_681 "combinator conversion "))) (($B ($B (_640 6))) (($B ($B _626)) _774)))) "ms")))))) (($B ($B _648)) (($B $P) (($C _587) (_578 "main"))))))))) (_683 ($T ((($C' ($C' $O)) ((($C' $B) $P) _406)) $K))))))) (($A :3 (($B (_646 _595)) (($B (($C' _596) ((($C' _769) (($B _698) (_706 ((_745 _785) (_638 "--"))))) 1))) (($B (_744 _7)) _4)))) (($A :4 ($T (($C ((($C' $C') (($B $S) ($C $C))) (($B ($B $Y)) (($B ($B ($B _568))) (($C' ($C' _683)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _5))) $K))))))) (($B (($S' _744) (($B _741) (($B (_744 _789)) (($B (_681 "not found ")) _584))))) ($C _569))))) (($A :5 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _7)) _5)) _5))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _7)) $K))) ((($C' $B) _5) _405))) ((($S' _744) (($B _741) (($B (_744 _789)) (_681 "primlookup: ")))) (($C (_720 _638)) _6)))) $K))) (_789 "trans: impossible"))) (($A :6 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67)
\ No newline at end of file
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -444,6 +444,11 @@
is _ = Nothing
satisfyM "QualDo" is
+pOperComma :: P Ident
+pOperComma = pOper <|< pComma
+ where
+ pComma = mkIdentLoc <$> getFileName <*> getLoc <*> ("," <$ pSpec ',')+
pAExpr :: P Expr
pAExpr = (
(EVar <$> pLQIdentSym)
@@ -451,8 +456,8 @@
<|< pLit
<|< (eTuple <$> (pSpec '(' *> esepBy1 pExpr (pSpec ',') <* pSpec ')'))<|< EListish <$> (pSpec '[' *> pListish <* pSpec ']')
- <|< (ESectL <$> (pSpec '(' *> pExprArg) <*> (pOper <* pSpec ')'))- <|< (ESectR <$> (pSpec '(' *> pOper) <*> (pExprArg <* pSpec ')'))+ <|< (ESectL <$> (pSpec '(' *> pExprArg) <*> (pOperComma <* pSpec ')'))+ <|< (ESectR <$> (pSpec '(' *> pOperComma) <*> (pExprArg <* pSpec ')'))<|< (ELit noSLoc . LPrim <$> (pKeyword "primitive" *> pString))
)
-- This weirdly slows down parsing
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -654,7 +654,7 @@
withExtVal i (ETypeScheme [] k) $ withVars iks ta
tcConstr :: Constr -> T Constr
-tcConstr (i, ts) = (,) i <$> T.mapM (\ t -> fst <$> tcTypeT (Just kType) t) ts
+tcConstr (i, ts) = (i,) <$> T.mapM (\ t -> fst <$> tcTypeT (Just kType) t) ts
tcDefsValue :: [EDef] -> T [EDef]
tcDefsValue ds = T.do
@@ -732,7 +732,7 @@
EVar i ->
if isUnderscore i then
-- this only happens with patterns translated into expressions
- (,) ae <$> newUVar
+ (ae,) <$> newUVar
else T.do
(e, t) <- tLookupInst "variable" i
-- traceM $ "*** " ++ i ++ " :: " ++ showExpr t ++ " = " ++ showMaybe showExpr mt
@@ -975,7 +975,7 @@
tcPat ::forall a . EType -> EPat -> (EPat -> T a) -> T a
tcPat t ap ta = T.do
-- traceM $ "tcPat: " ++ show ap
- env <- T.mapM (\ v -> ((,) v . ETypeScheme []) <$> newUVar) $ filter (not . isUnderscore) $ patVars ap
+ env <- T.mapM (\ v -> ((v,) . ETypeScheme []) <$> newUVar) $ filter (not . isUnderscore) $ patVars ap
withExtVals env $ T.do
(pp, _) <- tcExpr (Just t) ap
() <- checkArity (getSLocExpr ap) 0 pp
--
⑨