ref: ecd3c2ec78634f6a125d8d28d8ae2d04bce3ad04
parent: 3bf37ac6467745a4fa52474a628786f2c3022f6a
author: Lennart Augustsson <lennart@augustsson.net>
date: Sun Oct 29 11:28:46 EDT 2023
Only put exported classes in class table.
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -119,11 +119,10 @@
thisMdl = (mn, mkTModule tds tcs)
impMdls = [(fromMaybe m mm, tm) | (ImportSpec _ m mm _, tm) <- imps]
impMap = M.fromList [(i, m) | (i, m) <- thisMdl : impMdls]
- (texps, vexps) =
- unzip $ map (getTVExps impMap (typeTable tcs) (valueTable tcs) (assocTable tcs)) exps
+ (texps, cexps, vexps) =
+ unzip3 $ map (getTVExps impMap (typeTable tcs) (valueTable tcs) (assocTable tcs) (classTable tcs)) exps
fexps = [ fe | TModule _ fe _ _ _ _ _ _ <- M.elems impMap ]
sexps = M.toList (synTable tcs)
- cexps = [ ce | TModule _ _ _ _ ce _ _ _ <- M.elems impMap ]
iexps = M.toList (instTable tcs)
in tModule mn (nubBy ((==) `on` fst) (concat fexps)) (concat texps) sexps (concat cexps) iexps (concat vexps) tds
@@ -155,24 +154,27 @@
(imp, TModule mn fx ts' ss cs ins vs' a)
-- Type and value exports
-getTVExps :: forall a . M.Map (TModule a) -> TypeTable -> ValueTable -> AssocTable -> ExportItem ->
- ([TypeExport], [ValueExport])
-getTVExps impMap _ _ _ (ExpModule m) =
+getTVExps :: forall a . M.Map (TModule a) -> TypeTable -> ValueTable -> AssocTable -> ClassTable -> ExportItem ->
+ ([TypeExport], [ClsDef], [ValueExport])
+getTVExps impMap _ _ _ _ (ExpModule m) =
case M.lookup m impMap of
- Just (TModule _ _ te _ _ _ ve _) -> (te, ve)
+ Just (TModule _ _ te _ ce _ ve _) -> (te, ce, ve)
_ -> expErr m
-getTVExps _ tys vals ast (ExpTypeCon i) =
+getTVExps _ tys vals ast cls (ExpTypeCon i) =
let
e = expLookup i tys
qi = tyQIdent e
ves = getAssocs vals ast qi
- in ([TypeExport i e ves], [])
-getTVExps _ tys _ _ (ExpType i) =
+ Just ci = M.lookup qi cls
+ in ([TypeExport i e ves], [(qi, ci)], [])
+getTVExps _ tys _ _ cls (ExpType i) =
let
e = expLookup i tys
- in ([TypeExport i e []], [])
-getTVExps _ _ vals _ (ExpValue i) =
- ([], [ValueExport i (expLookup i vals)])
+ qi = tyQIdent e
+ Just ci = M.lookup qi cls
+ in ([TypeExport i e []], [(qi, ci)], [])
+getTVExps _ _ vals _ _ (ExpValue i) =
+ ([], [], [ValueExport i (expLookup i vals)])
-- Export all fixities and synonyms.
-- The synonyms might be needed, and the fixities are harmless
--
⑨