ref: 8e84f5f124437ddada60e8848d6bcef3aaa5a026
parent: 298bdbcbabdfed9d8fd23e20ab2b4eee58c2cc51
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Tue Sep 19 19:28:09 EDT 2023
Handle import lists
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.4
-845
-(($A :0 ((_641 _591) (($B ((($S' ($C ((($C' ($S' _641)) (($B ($C _2)) _574)) (($B ($B (_641 _670))) ((($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 _642)) ((($C' $B) (($B _739) (($B _660) ((($C' _776) _9) 0)))) (($B (_739 _663)) (($B (_676 "top level defns: ")) _621)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _642)) ((($C' $B) (($B _739) (($B _660) ((($C' _776) _9) 1)))) (_659 ($T (($B ($B (_739 _663))) ((($C' $B) (($B _676) ((($C' _676) _580) " = "))) (($C _400) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _10))) ((($S' $B) (($B ($C' ($C' _642))) ((($C' $B) ($B' (($B _739) (($B _665) _12)))) (($B _676) ((($C' _676) (($B (_676 _1)) _621)) (($O 10) $K)))))) (($B ($B (_641 _670))) ((($C' $B) ($B' (($B _739) (($B _660) ((($C' _776) _9) 0))))) (($B ($B (_739 _663))) ((($C' ($C' _676)) (($B ($B (_676 "final pass "))) (($B ($B (_635 6))) (($B ($B _621)) _770)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _681)) _400))) (($C _694) (_710 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _740) (($B _676) ((($C' _676) (($B (_676 "(($A :")) _621)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _740)) ($B _400))) (($B (_740 (_676 ") "))) (($C _740) (_676 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _375)) $I))) ($BK $K))) $K))))) (($B (($S' _739) (($B _736) (($B (_739 _783)) (($B (_676 "main: findIdent: ")) _580))))) (($C' _610) _577)))) _617))) (($B ($B _614)) ((($C' $B) (($B _678) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _577))) $K)))))) (($C _694) (_710 0))))))) ($T $A))) ($T $K))) $I)) (($B (_739 _374)) (($B (_739 _574)) (($B (_676 (($O 95) $K))) _621)))))))) (($S (($S ((($S' _8) (($B _693) (_680 (_633 "-v")))) ((_709 _633) "-r"))) (($B (_674 (($O 46) $K))) (($B _738) (_679 ((_698 _761) "-i")))))) (($B (_739 _705)) ((($C' _676) (($B _738) (_679 ((_698 _761) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _772) _693) 1)) (_783 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _705)) (_680 ((_740 _781) ((_740 (_633 (($O 45) $K))) (_691 1))))))) (_701 ((_740 _781) (_633 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _641)) _17) (($B ($B ($B (_641 _670)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _641) (($B _643) (_732 _220)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_641 _670))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _642))) ((($C' $B) ($B' (($B _739) (($B _660) ((($C' _776) _9) 0))))) (($B ($B (_739 _663))) ((($C' ($C' _676)) (($B ($B (_676 "combinator conversion "))) (($B ($B (_635 6))) (($B ($B _621)) _770)))) "ms")))))) (($B ($B _643)) (($B $P) (($C _583) (_574 "main"))))))))) (_678 ($T ((($C' ($C' $O)) ((($C' $B) $P) _403)) $K))))))) (($A :3 (($B (_641 _591)) (($B (($C' _592) ((($C' _765) (($B _693) (_701 ((_740 _781) (_633 "--"))))) 1))) (($B (_739 _7)) _4)))) (($A :4 ($T (($C ((($C' $C') (($B $S) ($C $C))) (($B ($B $Y)) (($B ($B ($B _565))) (($C' ($C' _678)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _5))) $K))))))) (($B (($S' _739) (($B _736) (($B (_739 _783)) (($B (_676 "not found ")) _580))))) ($C _566))))) (($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) _402))) ((($S' _739) (($B _736) (($B (_739 _783)) (_676 "primlookup: ")))) (($C (_715 _633)) _6)))) $K))) (_783 "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
+847
+(($A :0 ((_641 _591) (($B ((($S' ($C ((($C' ($S' _641)) (($B ($C _2)) _574)) (($B ($B (_641 _670))) ((($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 _642)) ((($C' $B) (($B _739) (($B _660) ((($C' _776) _9) 0)))) (($B (_739 _663)) (($B (_676 "top level defns: ")) _621)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _642)) ((($C' $B) (($B _739) (($B _660) ((($C' _776) _9) 1)))) (_659 ($T (($B ($B (_739 _663))) ((($C' $B) (($B _676) ((($C' _676) _580) " = "))) (($C _400) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _10))) ((($S' $B) (($B ($C' ($C' _642))) ((($C' $B) ($B' (($B _739) (($B _665) _12)))) (($B _676) ((($C' _676) (($B (_676 _1)) _621)) (($O 10) $K)))))) (($B ($B (_641 _670))) ((($C' $B) ($B' (($B _739) (($B _660) ((($C' _776) _9) 0))))) (($B ($B (_739 _663))) ((($C' ($C' _676)) (($B ($B (_676 "final pass "))) (($B ($B (_635 6))) (($B ($B _621)) _770)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _681)) _400))) (($C _694) (_710 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _740) (($B _676) ((($C' _676) (($B (_676 "(($A :")) _621)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _740)) ($B _400))) (($B (_740 (_676 ") "))) (($C _740) (_676 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _375)) $I))) ($BK $K))) $K))))) (($B (($S' _739) (($B _736) (($B (_739 _785)) (($B (_676 "main: findIdent: ")) _580))))) (($C' _610) _577)))) _617))) (($B ($B _614)) ((($C' $B) (($B _678) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _577))) $K)))))) (($C _694) (_710 0))))))) ($T $A))) ($T $K))) $I)) (($B (_739 _374)) (($B (_739 _574)) (($B (_676 (($O 95) $K))) _621)))))))) (($S (($S ((($S' _8) (($B _693) (_680 (_633 "-v")))) ((_709 _633) "-r"))) (($B (_674 (($O 46) $K))) (($B _738) (_679 ((_698 _761) "-i")))))) (($B (_739 _705)) ((($C' _676) (($B _738) (_679 ((_698 _761) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _772) _693) 1)) (_785 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _705)) (_680 ((_740 _781) ((_740 (_633 (($O 45) $K))) (_691 1))))))) (_701 ((_740 _781) (_633 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _641)) _17) (($B ($B ($B (_641 _670)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _641) (($B _643) (_732 _220)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_641 _670))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _642))) ((($C' $B) ($B' (($B _739) (($B _660) ((($C' _776) _9) 0))))) (($B ($B (_739 _663))) ((($C' ($C' _676)) (($B ($B (_676 "combinator conversion "))) (($B ($B (_635 6))) (($B ($B _621)) _770)))) "ms")))))) (($B ($B _643)) (($B $P) (($C _583) (_574 "main"))))))))) (_678 ($T ((($C' ($C' $O)) ((($C' $B) $P) _403)) $K))))))) (($A :3 (($B (_641 _591)) (($B (($C' _592) ((($C' _765) (($B _693) (_701 ((_740 _781) (_633 "--"))))) 1))) (($B (_739 _7)) _4)))) (($A :4 ($T (($C ((($C' $C') (($B $S) ($C $C))) (($B ($B $Y)) (($B ($B ($B _565))) (($C' ($C' _678)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _5))) $K))))))) (($B (($S' _739) (($B _736) (($B (_739 _785)) (($B (_676 "not found ")) _580))))) ($C _566))))) (($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) _402))) ((($S' _739) (($B _736) (($B (_739 _785)) (_676 "primlookup: ")))) (($C (_715 _633)) _6)))) $K))) (_785 "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/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -40,16 +40,17 @@
type FixTable = M.Map Fixity
typeCheck :: forall a . [(ImportSpec, TModule a)] -> EModule -> TModule [EDef]
-typeCheck imps (EModule mn exps defs) =
+typeCheck aimps (EModule mn exps defs) =
-- trace (show amdl) $
let
+ imps = map filterImports aimps
(fs, ts, ss, vs) = mkTables imps
in case tcRun (tcDefs defs) (initTC mn fs ts ss vs) of
(tds, tcs) ->
let
thisMdl = (mn, mkTModule mn tds impossible)
- impMdls = [(fromMaybe m mm, filterImports mis tm) | (ImportSpec _ m mm mis, tm) <- imps]
- impMap = M.fromList [(i, m) | (i, m) <- (thisMdl : impMdls)]
+ impMdls = [(fromMaybe m mm, tm) | (ImportSpec _ m mm _, tm) <- imps]
+ impMap = M.fromList [(i, m) | (i, m) <- thisMdl : impMdls]
(texps, sexps, vexps) =
unzip3 $ map (getTVExps impMap (typeTable tcs) (synTable tcs) (valueTable tcs)) exps
{-@@ -61,9 +62,20 @@
fexps = [ fe | TModule _ fe _ _ _ _ <- M.elems impMap ]
in TModule mn (nubBy (eqIdent `on` fst) (concat fexps)) (concat texps) (concat sexps) (concat vexps) tds
-filterImports :: forall a . Maybe (Bool, [ImportItem]) -> TModule a -> TModule a
-filterImports Nothing tm = tm
-filterImports (Just (_hide, _is)) tm = tm -- XXX
+filterImports :: forall a . (ImportSpec, TModule a) -> (ImportSpec, TModule a)
+filterImports it@(ImportSpec _ _ _ Nothing, _) = it
+filterImports (imp@(ImportSpec _ _ _ (Just (hide, is))), TModule mn fx ts ss vs a) =
+ let
+ keep x xs = elemBy eqIdent x xs `neBool` hide
+ ivs = [ i | ImpValue i <- is ]
+ vs' = filter (\ (ValueExport i _) -> keep i ivs) vs
+ cts = [ i | ImpTypeCon i <- is ]
+ its = [ i | ImpType i <- is ] ++ cts
+ ts' = map (\ te@(TypeExport i e _) -> if keep i cts then te else TypeExport i e []) $
+ filter (\ (TypeExport i _ _) -> keep i its) ts
+ in
+ --trace (show (ts, vs)) $
+ (imp, TModule mn fx ts' ss vs' a)
-- Type and value exports
getTVExps :: forall a . M.Map (TModule a) -> TypeTable -> SynTable -> ValueTable -> ExportItem ->
@@ -77,7 +89,7 @@
let
e = expLookup i tys
qi = tyQIdent e
- in ([TypeExport i e []], [], constrsOf qi (M.toList vals))
+ in ([TypeExport i e $ constrsOf qi (M.toList vals)], [], [])
getTVExps _ tys syns _ (ExpType i) =
let
e = expLookup i tys
--
⑨