ref: 8accc5fc85f2072f6f6e81f89a10688f089e7abc
parent: 30c0f95205f8f5ec8d312ff6d687e0481b916b90
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Oct 12 10:09:10 EDT 2023
Get rid of ETypeScheme.
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-973
-((A :0 _857) ((A :1 ((B _903) _0)) ((A :2 (((S' _903) _0) I)) ((A :3 _827) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _856) ((C _74) _5))) ((A :7 (((C' _6) (_874 _71)) ((_74 _872) _70))) ((A :8 ((B ((S _903) _872)) _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 _785)))) ((A :18 ((B (_73 _9)) (BK (P _785)))) ((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 _785)))) ((B (C' B)) (B _13))))) ((A :23 _3) ((A :24 (T (_14 _785))) ((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 _832) ((A :35 _833) ((A :36 (((S' _27) (_824 #97)) ((C _824) #122))) ((A :37 (((S' _27) (_824 #65)) ((C _824) #90))) ((A :38 (((S' _26) _36) _37)) ((A :39 (((S' _27) (_824 #48)) ((C _824) #57))) ((A :40 (((S' _27) (_824 #32)) ((C _824) #126))) ((A :41 _821) ((A :42 _822) ((A :43 _824) ((A :44 _823) ((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 (((_784 "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 (((_784 "lib/Data/Char.hs") #3) #8)))) ((B _34) (((C' _81) (((C' _82) _35) (_35 #97))) (_35 #65))))) ((A :48 _792) ((A :49 _793) ((A :50 _794) ((A :51 _795) ((A :52 (_49 %0.0)) ((A :53 _48) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _796) ((A :58 _797) ((A :59 _57) ((A :60 _58) ((A :61 _798) ((A :62 _799) ((A :63 _800) ((A :64 _801) ((A :65 _61) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _802) ((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 _828) ((A :79 ((C ((C S') _188)) _189)) ((A :80 (((C' (S' (C' B))) B) I)) ((A :81 _786) ((A :82 _787) ((A :83 _788) ((A :84 _789) ((A :85 _790) ((A :86 _791) ((A :87 (_82 #0)) ((A :88 _809) ((A :89 _810) ((A :90 _811) ((A :91 _812) ((A :92 _813) ((A :93 _814) ((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 (B (B (B (B BK))))))) (((C' B) (B' (B' ((B (C' (C' (C' C)))) ((B ((C' B) (B' ((B C) _90)))) ((B ((C' B) _115)) _104)))))) ((B ((C' B) _115)) (C _104)))))))))) (((_784 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :105 ((_74 (_120 _188)) _103)) ((A :106 (((C' C) (((C' C) (C _100)) (_3 "Data.IntMap.!"))) I)) ((A :107 ((B ((C' B) T)) ((B (B Y)) (((C' (C' (S' (S' C)))) ((B ((S' B) ((B (S' P)) (C _96)))) ((B (B ((C' (
\ No newline at end of file
+972
+((A :0 _856) ((A :1 ((B _902) _0)) ((A :2 (((S' _902) _0) I)) ((A :3 _826) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _855) ((C _74) _5))) ((A :7 (((C' _6) (_873 _71)) ((_74 _871) _70))) ((A :8 ((B ((S _902) _871)) _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 _784)))) ((A :18 ((B (_73 _9)) (BK (P _784)))) ((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 _784)))) ((B (C' B)) (B _13))))) ((A :23 _3) ((A :24 (T (_14 _784))) ((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 _831) ((A :35 _832) ((A :36 (((S' _27) (_823 #97)) ((C _823) #122))) ((A :37 (((S' _27) (_823 #65)) ((C _823) #90))) ((A :38 (((S' _26) _36) _37)) ((A :39 (((S' _27) (_823 #48)) ((C _823) #57))) ((A :40 (((S' _27) (_823 #32)) ((C _823) #126))) ((A :41 _820) ((A :42 _821) ((A :43 _823) ((A :44 _822) ((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 (((_783 "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 (((_783 "lib/Data/Char.hs") #3) #8)))) ((B _34) (((C' _81) (((C' _82) _35) (_35 #97))) (_35 #65))))) ((A :48 _791) ((A :49 _792) ((A :50 _793) ((A :51 _794) ((A :52 (_49 %0.0)) ((A :53 _48) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _795) ((A :58 _796) ((A :59 _57) ((A :60 _58) ((A :61 _797) ((A :62 _798) ((A :63 _799) ((A :64 _800) ((A :65 _61) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _801) ((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 _827) ((A :79 ((C ((C S') _188)) _189)) ((A :80 (((C' (S' (C' B))) B) I)) ((A :81 _785) ((A :82 _786) ((A :83 _787) ((A :84 _788) ((A :85 _789) ((A :86 _790) ((A :87 (_82 #0)) ((A :88 _808) ((A :89 _809) ((A :90 _810) ((A :91 _811) ((A :92 _812) ((A :93 _813) ((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 (B (B (B (B BK))))))) (((C' B) (B' (B' ((B (C' (C' (C' C)))) ((B ((C' B) (B' ((B C) _90)))) ((B ((C' B) _115)) _104)))))) ((B ((C' B) _115)) (C _104)))))))))) (((_783 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :105 ((_74 (_120 _188)) _103)) ((A :106 (((C' C) (((C' C) (C _100)) (_3 "Data.IntMap.!"))) I)) ((A :107 ((B ((C' B) T)) ((B (B Y)) (((C' (C' (S' (S' C)))) ((B ((S' B) ((B (S' P)) (C _96)))) ((B (B ((C' (
\ No newline at end of file
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -15,7 +15,6 @@
EAlt,
ECaseArm,
EType, showEType,
- ETypeScheme,
EPat, patVars, isPVar, isPConApp,
EKind, kType,
IdKind(..), idKindIdent,
@@ -191,9 +190,6 @@
-- * after desugaring: EApp and EVar
-- * before desugaring: EApp, EVar, ETuple, EList
type EType = Expr
-
--- A type starting with an EForall
-type ETypeScheme = EType
data IdKind = IdKind Ident EKind
--Xderiving (Show, Eq)
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -252,7 +252,7 @@
<|< Newtype <$> (pKeyword "newtype" *> pLHS) <*> (pSymbol "=" *> pUIdent) <*> pAType
<|< Type <$> (pKeyword "type" *> pLHS) <*> (pSymbol "=" *> pType)
<|< uncurry Fcn <$> pEqns
- <|< Sign <$> (pLIdentSym <* pSymbol "::") <*> pTypeScheme
+ <|< Sign <$> (pLIdentSym <* pSymbol "::") <*> pType
<|< Import <$> (pKeyword "import" *> pImportSpec)
<|< ForImp <$> (pKeyword "foreign" *> pKeyword "import" *> pKeyword "ccall" *> pString) <*> pLIdent <*> (pSymbol "::" *> pType)
<|< Infix <$> ((,) <$> pAssoc <*> pPrec) <*> esepBy1 pTypeOper (pSpec ',')
@@ -289,16 +289,6 @@
pKind :: P EKind
pKind = pType
-{--pTypeScheme :: P ETypeScheme
-pTypeScheme = P.do
- vs <- (pKeyword "forall" *> esome pIdKind <* pSymbol ".") <|< pure []
- t <- pType
- pure $ if null vs then t else EForall vs t
--}
-pTypeScheme :: P ETypeScheme
-pTypeScheme = pType
-
--
-- Partial copy of pExpr, but that includes '->'.
-- Including '->' in pExprOp interacts poorly with '->'
@@ -529,7 +519,7 @@
pBind =
uncurry BFcn <$> pEqns
<|< BPat <$> (pPatNotVar <* pSymbol "=") <*> pExpr
- <|< BSign <$> (pLIdentSym <* pSymbol "::") <*> pTypeScheme
+ <|< BSign <$> (pLIdentSym <* pSymbol "::") <*> pType
-------------
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -29,18 +29,18 @@
--Xderiving (Show)
type FixDef = (Ident, Fixity)
-type SynDef = (Ident, ETypeScheme)
+type SynDef = (Ident, EType)
-data Entry = Entry Expr ETypeScheme
+data Entry = Entry Expr EType
--Xderiving(Show)
-entryType :: Entry -> ETypeScheme
+entryType :: Entry -> EType
entryType (Entry _ t) = t
type ValueTable = M.Map [Entry]
type TypeTable = M.Map [Entry]
type KindTable = M.Map [Entry]
-type SynTable = M.Map ETypeScheme
+type SynTable = M.Map EType
type FixTable = M.Map Fixity
type Sigma = EType
@@ -320,13 +320,13 @@
xvs = foldr (uncurry M.insert) vs primValues
in TC mn 1 fs xts ss xvs IM.empty TCExpr
-kTypeS :: ETypeScheme
+kTypeS :: EType
kTypeS = kType
-kTypeTypeS :: ETypeScheme
+kTypeTypeS :: EType
kTypeTypeS = kArrow kType kType
-kTypeTypeTypeS :: ETypeScheme
+kTypeTypeTypeS :: EType
kTypeTypeTypeS = kArrow kType $ kArrow kType kType
builtinLoc :: SLoc
@@ -584,7 +584,7 @@
T.return (e, t)
tLookup :: --XHasCallStack =>
- String -> Ident -> T (Expr, ETypeScheme)
+ String -> Ident -> T (Expr, EType)
tLookup msg i = T.do
env <- gets valueTable
case M.lookup i env of
@@ -593,7 +593,7 @@
Just [Entry e s] -> T.return (setSLocExpr (getSLocIdent i) e, s)
Just _ -> tcError (getSLocIdent i) $ "ambiguous " ++ msg ++ ": " ++ showIdent i
-tInst :: ETypeScheme -> T EType
+tInst :: EType -> T EType
tInst as =
case as of
EForall vks t ->
@@ -605,34 +605,34 @@
t -> T.return t
extValE :: --XHasCallStack =>
- Ident -> ETypeScheme -> Expr -> T ()
+ Ident -> EType -> Expr -> T ()
extValE i t e = T.do
venv <- gets valueTable
putValueTable (M.insert i [Entry e t] venv)
extQVal :: --XHasCallStack =>
- Ident -> ETypeScheme -> T ()
+ Ident -> EType -> T ()
extQVal i t = T.do
mn <- gets moduleName
extValE i t (EVar $ qualIdent mn i)
extVal :: --XHasCallStack =>
- Ident -> ETypeScheme -> T ()
+ Ident -> EType -> T ()
extVal i t = extValE i t $ EVar i
extVals :: --XHasCallStack =>
- [(Ident, ETypeScheme)] -> T ()
+ [(Ident, EType)] -> T ()
extVals = T.mapM_ (uncurry extVal)
-extTyp :: Ident -> ETypeScheme -> T ()
+extTyp :: Ident -> EType -> T ()
extTyp i t = T.do
tenv <- gets typeTable
putTypeTable (M.insert i [Entry (EVar i) t] tenv)
-extTyps :: [(Ident, ETypeScheme)] -> T ()
+extTyps :: [(Ident, EType)] -> T ()
extTyps = T.mapM_ (uncurry extTyp)
-extSyn :: Ident -> ETypeScheme -> T ()
+extSyn :: Ident -> EType -> T ()
extSyn i t = T.do
senv <- gets synTable
putSynTable (M.insert i t senv)
@@ -644,7 +644,7 @@
T.return ()
withExtVal :: forall a . --XHasCallStack =>
- Ident -> ETypeScheme -> T a -> T a
+ Ident -> EType -> T a -> T a
withExtVal i t ta = T.do
venv <- gets valueTable
extVal i t
@@ -653,7 +653,7 @@
T.return a
withExtVals :: forall a . --XHasCallStack =>
- [(Ident, ETypeScheme)] -> T a -> T a
+ [(Ident, EType)] -> T a -> T a
withExtVals env ta = T.do
venv <- gets valueTable
extVals env
@@ -1265,7 +1265,7 @@
nbs <- T.mapM tcBind xbs
ta nbs
-tcBindVarT :: M.Map ETypeScheme -> Ident -> T (Ident, ETypeScheme)
+tcBindVarT :: M.Map EType -> Ident -> T (Ident, EType)
tcBindVarT tmap x = T.do
case M.lookup x tmap of
Nothing -> T.do
--
⑨