ref: 1f6b8959e0e561f7e2b64e26f5d1cdbcdb19d7fa
parent: ac6c9473cdcc908c039a10281c703b7a073dceff
parent: 5041342c9ce33c1de26c42a162119f50c0f3671d
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Mon Oct 16 10:42:24 EDT 2023
Merge branch 'master' into class
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-999
-((A :0 _883) ((A :1 ((B _929) _0)) ((A :2 (((S' _929) _0) I)) ((A :3 _853) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _882) ((C _75) _5))) ((A :7 (((C' _6) (_900 _72)) ((_75 _898) _71))) ((A :8 ((B ((S _929) _898)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_75 _190)) _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 _811)))) ((A :19 ((B (_74 _9)) (BK (P _811)))) ((A :20 ((_74 _9) ((S P) I))) ((A :21 ((B (_74 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _115)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _116)))))) ((A :23 ((B Y) ((B (B (P (_14 _811)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _811))) ((A :26 (_22 _76)) ((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 _858) ((A :36 _859) ((A :37 (((S' _28) (_850 #97)) ((C _850) #122))) ((A :38 (((S' _28) (_850 #65)) ((C _850) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_850 #48)) ((C _850) #57))) ((A :41 (((S' _28) (_850 #32)) ((C _850) #126))) ((A :42 _847) ((A :43 _848) ((A :44 _850) ((A :45 _849) ((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 (((_809 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _82) (((C' _83) _36) (_36 #65))) (_36 #97))))) ((A :48 ((S ((S (((S' _28) (_44 #97)) ((C _44) #97))) (_34 (((_809 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _82) (((C' _83) _36) (_36 #97))) (_36 #65))))) ((A :49 _818) ((A :50 _819) ((A :51 _820) ((A :52 _821) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _822) ((A :59 _823) ((A :60 _58) ((A :61 _59) ((A :62 _824) ((A :63 _825) ((A :64 _826) ((A :65 _827) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _828) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 I) ((A :75 B) ((A :76 I) ((A :77 K) ((A :78 C) ((A :79 _854) ((A :80 ((C ((C S') _190)) _191)) ((A :81 (((C' (S' (C' B))) B) I)) ((A :82 _812) ((A :83 _813) ((A :84 _814) ((A :85 _815) ((A :86 _816) ((A :87 _817) ((A :88 (_83 #0)) ((A :89 _835) ((A :90 _836) ((A :91 _837) ((A :92 _838) ((A :93 _839) ((A :94 _840) ((A :95 _89) ((A :96 (BK K)) ((A :97 ((B BK) ((B (B BK)) P))) ((A :98 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :99 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_92 #0))) (_89 #0)))) ((B (B ((C' P) (_87 #1)))) _82))) (C P))) _85)) _86)) ((A :100 _96) ((A :101 (((S' C) ((B (P _178)) (((C' (C' B)) (((C' C) _89) _178)) _179))) ((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') (_89 #0))))) ((B ((C' (C' C)) ((B (B ((S' S') (_89 #1)))) ((B ((C' C) ((B ((C' S') (_89 #2))) (C _101)))) (C _101))))) (C _101))))) (C _101)))) (T K))) (T A)))) ((C _99) #4)))) ((A :102 (_108 _77)) ((A :103 ((_123 (_80 _102)) _100)) ((A :104 ((C (((C' B) ((P _115) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _105)))) (((S' (C' (C' B))) ((B (B (B _105))) (((S' (C' B)) ((B (B _105)) (((C' B) ((B _121) (T #0))) _104))) (((C' B) ((B _121) (T #1))) _104)))) (((C' B) ((B _121) (T #2))) _104)))) (((C' B) ((B _121) (T #3))) _104)))) ((B T) ((B (B P)) ((C' _82) (_84 #4)))))) ((A :105 ((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) _91)))) ((B ((C' B) _116)) _105)))))) ((B ((C' B) _116)) (C _105)))))))))) (((_809 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :106 ((_75 (_121 _190)) _104)) ((A :107 (((C' C) (((C' C) (C _101)) (_3 "Data.IntMap.!"))) I)) ((A :108 ((B ((C' B) T)) ((B (B Y)) (((C' (C' (S' (S' C)))) ((B
\ No newline at end of file
+998
+((A :0 _882) ((A :1 ((B _928) _0)) ((A :2 (((S' _928) _0) I)) ((A :3 _852) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _881) ((C _75) _5))) ((A :7 (((C' _6) (_899 _72)) ((_75 _897) _71))) ((A :8 ((B ((S _928) _897)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_75 _190)) _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 _810)))) ((A :19 ((B (_74 _9)) (BK (P _810)))) ((A :20 ((_74 _9) ((S P) I))) ((A :21 ((B (_74 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _115)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _116)))))) ((A :23 ((B Y) ((B (B (P (_14 _810)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _810))) ((A :26 (_22 _76)) ((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 _857) ((A :36 _858) ((A :37 (((S' _28) (_849 #97)) ((C _849) #122))) ((A :38 (((S' _28) (_849 #65)) ((C _849) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_849 #48)) ((C _849) #57))) ((A :41 (((S' _28) (_849 #32)) ((C _849) #126))) ((A :42 _846) ((A :43 _847) ((A :44 _849) ((A :45 _848) ((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 (((_808 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _82) (((C' _83) _36) (_36 #65))) (_36 #97))))) ((A :48 ((S ((S (((S' _28) (_44 #97)) ((C _44) #97))) (_34 (((_808 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _82) (((C' _83) _36) (_36 #97))) (_36 #65))))) ((A :49 _817) ((A :50 _818) ((A :51 _819) ((A :52 _820) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _821) ((A :59 _822) ((A :60 _58) ((A :61 _59) ((A :62 _823) ((A :63 _824) ((A :64 _825) ((A :65 _826) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _827) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 I) ((A :75 B) ((A :76 I) ((A :77 K) ((A :78 C) ((A :79 _853) ((A :80 ((C ((C S') _190)) _191)) ((A :81 (((C' (S' (C' B))) B) I)) ((A :82 _811) ((A :83 _812) ((A :84 _813) ((A :85 _814) ((A :86 _815) ((A :87 _816) ((A :88 (_83 #0)) ((A :89 _834) ((A :90 _835) ((A :91 _836) ((A :92 _837) ((A :93 _838) ((A :94 _839) ((A :95 _89) ((A :96 (BK K)) ((A :97 ((B BK) ((B (B BK)) P))) ((A :98 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :99 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_92 #0))) (_89 #0)))) ((B (B ((C' P) (_87 #1)))) _82))) (C P))) _85)) _86)) ((A :100 _96) ((A :101 (((S' C) ((B (P _178)) (((C' (C' B)) (((C' C) _89) _178)) _179))) ((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') (_89 #0))))) ((B ((C' (C' C)) ((B (B ((S' S') (_89 #1)))) ((B ((C' C) ((B ((C' S') (_89 #2))) (C _101)))) (C _101))))) (C _101))))) (C _101)))) (T K))) (T A)))) ((C _99) #4)))) ((A :102 (_108 _77)) ((A :103 ((_123 (_80 _102)) _100)) ((A :104 ((C (((C' B) ((P _115) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _105)))) (((S' (C' (C' B))) ((B (B (B _105))) (((S' (C' B)) ((B (B _105)) (((C' B) ((B _121) (T #0))) _104))) (((C' B) ((B _121) (T #1))) _104)))) (((C' B) ((B _121) (T #2))) _104)))) (((C' B) ((B _121) (T #3))) _104)))) ((B T) ((B (B P)) ((C' _82) (_84 #4)))))) ((A :105 ((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) _91)))) ((B ((C' B) _116)) _105)))))) ((B ((C' B) _116)) (C _105)))))))))) (((_808 "lib/Data/IntMap.hs") #3) #8))))))))) ((A :106 ((_75 (_121 _190)) _104)) ((A :107 (((C' C) (((C' C) (C _101)) (_3 "Data.IntMap.!"))) I)) ((A :108 ((B ((C' B) T)) ((B (B Y)) (((C' (C' (S' (S' C)))) ((B
\ No newline at end of file
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -76,7 +76,7 @@
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)) exps
+ unzip $ map (getTVExps impMap (typeTable tcs) (valueTable tcs) (assocTable tcs)) exps
fexps = [ fe | TModule _ fe _ _ _ _ <- M.elems impMap ]
sexps = [ se | TModule _ _ _ se _ _ <- M.elems impMap ]
in tModule mn (nubBy (eqIdent `on` fst) (concat fexps)) (concat texps) (concat sexps) (concat vexps) tds
@@ -107,22 +107,23 @@
(imp, TModule mn fx ts' ss vs' a)
-- Type and value exports
-getTVExps :: forall a . M.Map (TModule a) -> TypeTable -> ValueTable -> ExportItem ->
+getTVExps :: forall a . M.Map (TModule a) -> TypeTable -> ValueTable -> AssocTable -> ExportItem ->
([TypeExport], [ValueExport])
-getTVExps impMap _ _ (ExpModule m) =
+getTVExps impMap _ _ _ (ExpModule m) =
case M.lookup m impMap of
Just (TModule _ _ te _ ve _) -> (te, ve)
_ -> expErr m
-getTVExps _ tys vals (ExpTypeCon i) =
+getTVExps _ tys vals ast (ExpTypeCon i) =
let
e = expLookup i tys
qi = tyQIdent e
- in ([TypeExport i e $ constrsOf qi (M.toList vals)], [])
-getTVExps _ tys _ (ExpType i) =
+ ves = getAssocs vals ast qi
+ in ([TypeExport i e ves], [])
+getTVExps _ tys _ _ (ExpType i) =
let
e = expLookup i tys
in ([TypeExport i e []], [])
-getTVExps _ _ vals (ExpValue i) =
+getTVExps _ _ vals _ (ExpValue i) =
([], [ValueExport i (expLookup i vals)])
-- Export all fixities and synonyms.
@@ -141,16 +142,11 @@
tyQIdent (Entry (EVar qi) _) = qi
tyQIdent _ = error "tyQIdent"
-constrsOf :: Ident -> [(Ident, [Entry])] -> [ValueExport]
-constrsOf qi ies =
- [ ValueExport i e | (i, es) <- ies, e@(Entry (ECon _) t) <- es, eqIdent (retTyCon t) qi ]
+eVarI :: SLoc -> String -> Expr
+eVarI loc = EVar . mkIdentSLoc loc
-retTyCon :: EType -> Ident
-retTyCon (EForall _ t) = retTyCon t
-retTyCon t =
- case getArrow t of
- Nothing -> getAppCon t
- Just (_, a) -> retTyCon a
+expErr :: forall a . Ident -> a
+expErr i = errorMessage (getSLocIdent i) $ "export undefined " ++ showIdent i
getAppCon :: EType -> Ident
getAppCon (EVar i) = i
@@ -157,12 +153,6 @@
getAppCon (EApp f _) = getAppCon f
getAppCon _ = error "getAppCon"
-eVarI :: SLoc -> String -> Expr
-eVarI loc = EVar . mkIdentSLoc loc
-
-expErr :: forall a . Ident -> a
-expErr i = errorMessage (getSLocIdent i) $ "export undefined " ++ showIdent i
-
-- Construct a dummy TModule for the currently compiled module.
-- It has all the relevant export tables.
-- The value&type export tables will later be filtered through the export list.
@@ -180,12 +170,7 @@
Just [e] -> e
_ -> impossible
-- Find all value Entry for names associated with a type.
- assoc i =
- let qis = fromMaybe [] $ M.lookup (qualIdent mn i) at
- val qi = case M.lookup qi vt of
- Just [e] -> e
- _ -> impossible
- in map (\ qi -> ValueExport (unQualIdent qi) (val qi)) qis
+ assoc i = getAssocs vt at (qualIdent mn i)
-- All top level values possible to export.
ves = [ ValueExport i (Entry (EVar (qualIdent mn i)) ts) | Sign i ts <- tds ]
@@ -202,6 +187,15 @@
-- All fixity declaration.
fes = [ (qualIdent mn i, fx) | Infix fx is <- tds, i <- is ]
in TModule mn fes tes ses ves impossible
+
+-- Find all value Entry for names associated with a type.
+getAssocs :: ValueTable -> AssocTable -> Ident -> [ValueExport]
+getAssocs vt at ai =
+ let qis = fromMaybe [] $ M.lookup ai at
+ val qi = case M.lookup qi vt of
+ Just [e] -> e
+ _ -> impossible
+ in map (\ qi -> ValueExport (unQualIdent qi) (val qi)) qis
mkTables :: forall a . [(ImportSpec, TModule a)] -> (FixTable, TypeTable, SynTable, ValueTable, AssocTable)
mkTables mdls =
--
⑨