ref: 05c71fc3c8b47597a6c2bf422a58ef8c4dbb64b9
parent: 6979f0df47831451685f13662ac60b82d4f03f9c
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Tue Sep 19 13:47:19 EDT 2023
Parse (but not process) import list.
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.4
-839
-(($A :0 ((_635 _585) (($B ((($S' ($C ((($C' ($S' _635)) (($B ($C _2)) _568)) (($B ($B (_635 _664))) ((($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 _636)) ((($C' $B) (($B _733) (($B _654) ((($C' _770) _9) 0)))) (($B (_733 _657)) (($B (_670 "top level defns: ")) _615)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _636)) ((($C' $B) (($B _733) (($B _654) ((($C' _770) _9) 1)))) (_653 ($T (($B ($B (_733 _657))) ((($C' $B) (($B _670) ((($C' _670) _574) " = "))) (($C _398) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _10))) ((($S' $B) (($B ($C' ($C' _636))) ((($C' $B) ($B' (($B _733) (($B _659) _12)))) (($B _670) ((($C' _670) (($B (_670 _1)) _615)) (($O 10) $K)))))) (($B ($B (_635 _664))) ((($C' $B) ($B' (($B _733) (($B _654) ((($C' _770) _9) 0))))) (($B ($B (_733 _657))) ((($C' ($C' _670)) (($B ($B (_670 "final pass "))) (($B ($B (_629 6))) (($B ($B _615)) _764)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _675)) _398))) (($C _688) (_704 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _734) (($B _670) ((($C' _670) (($B (_670 "(($A :")) _615)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _734)) ($B _398))) (($B (_734 (_670 ") "))) (($C _734) (_670 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _373)) $I))) ($BK $K))) $K))))) (($B (($S' _733) (($B _730) (($B (_733 _777)) (($B (_670 "main: findIdent: ")) _574))))) (($C' _604) _571)))) _611))) (($B ($B _608)) ((($C' $B) (($B _672) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _571))) $K)))))) (($C _688) (_704 0))))))) ($T $A))) ($T $K))) $I)) (($B (_733 _372)) (($B (_733 _568)) (($B (_670 (($O 95) $K))) _615)))))))) (($S (($S ((($S' _8) (($B _687) (_674 (_627 "-v")))) ((_703 _627) "-r"))) (($B (_668 (($O 46) $K))) (($B _732) (_673 ((_692 _755) "-i")))))) (($B (_733 _699)) ((($C' _670) (($B _732) (_673 ((_692 _755) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _766) _687) 1)) (_777 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _699)) (_674 ((_734 _775) ((_734 (_627 (($O 45) $K))) (_685 1))))))) (_695 ((_734 _775) (_627 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _635)) _17) (($B ($B ($B (_635 _664)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _635) (($B _637) (_726 _219)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_635 _664))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _636))) ((($C' $B) ($B' (($B _733) (($B _654) ((($C' _770) _9) 0))))) (($B ($B (_733 _657))) ((($C' ($C' _670)) (($B ($B (_670 "combinator conversion "))) (($B ($B (_629 6))) (($B ($B _615)) _764)))) "ms")))))) (($B ($B _637)) (($B $P) (($C _577) (_568 "main"))))))))) (_672 ($T ((($C' ($C' $O)) ((($C' $B) $P) _401)) $K))))))) (($A :3 (($B (_635 _585)) (($B (($C' _586) ((($C' _759) (($B _687) (_695 ((_734 _775) (_627 "--"))))) 1))) (($B (_733 _7)) _4)))) (($A :4 ($T (($C ((($C' $C') (($B $S) ($C $C))) (($B ($B $Y)) (($B ($B ($B _559))) (($C' ($C' _672)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _5))) $K))))))) (($B (($S' _733) (($B _730) (($B (_733 _777)) (($B (_670 "not found ")) _574))))) ($C _560))))) (($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) _400))) ((($S' _733) (($B _730) (($B (_733 _777)) (_670 "primlookup: ")))) (($C (_709 _627)) _6)))) $K))) (_777 "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
+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
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -100,7 +100,7 @@
let
specs = [ s | Import s <- defs ]
t2 <- liftIO getTimeMilli
- (impMdls, ts) <- S.fmap unzip $ S.mapM (compileModuleCached flags) [ m | ImportSpec _ m _ <- specs ]
+ (impMdls, ts) <- S.fmap unzip $ S.mapM (compileModuleCached flags) [ m | ImportSpec _ m _ _ <- specs ]
t3 <- liftIO getTimeMilli
let
tmdl = typeCheck (zip specs impMdls) mdl
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -3,6 +3,7 @@
EModule(..),
ExportItem(..),
ImportSpec(..),
+ ImportItem(..),
EDef(..), showEDefs,
Expr(..), showExpr,
Listish(..),
@@ -61,9 +62,15 @@
| Infix Fixity [Ident]
--Xderiving (Show, Eq)
-data ImportSpec = ImportSpec Bool Ident (Maybe Ident)
+data ImportSpec = ImportSpec Bool Ident (Maybe Ident) (Maybe (Bool, [ImportItem])) -- first Bool indicates 'qualified', second 'hiding'
--Xderiving (Show, Eq)
+data ImportItem
+ = ImpTypeCon Ident
+ | ImpType Ident
+ | ImpValue Ident
+ --Xderiving (Show, Eq)
+
data Expr
= EVar Ident
| EApp Expr Expr
@@ -334,6 +341,13 @@
ExpValue i -> i
-}
+showImportItem :: ImportItem -> String
+showImportItem ae =
+ case ae of
+ ImpTypeCon i -> showIdent i ++ "(..)"
+ ImpType i -> showIdent i
+ ImpValue i -> showIdent i
+
showEDef :: EDef -> String
showEDef def =
case def of
@@ -342,7 +356,10 @@
Type lhs t -> "type " ++ showLHS lhs ++ " = " ++ showEType t
Fcn i eqns -> unlines (map (\ (Eqn ps alts) -> showIdent i ++ " " ++ unwords (map showEPat ps) ++ showAlts "=" alts) eqns)
Sign i t -> showIdent i ++ " :: " ++ showETypeScheme t
- Import (ImportSpec q m mm) -> "import " ++ (if q then "qualified " else "") ++ showIdent m ++ maybe "" ((" as " ++) . unIdent) mm+ Import (ImportSpec q m mm mis) -> "import " ++ (if q then "qualified " else "") ++ showIdent m ++ maybe "" ((" as " ++) . unIdent) mm +++ case mis of
+ Nothing -> ""
+ Just (h, is) -> (if h then " hiding" else "") ++ "(" ++ intercalate ", " (map showImportItem is) ++ ")"ForImp ie i t -> "foreign import ccall " ++ showString ie ++ " " ++ showIdent i ++ " :: " ++ showEType t
Infix (a, p) is -> "infix" ++ f a ++ " " ++ showInt p ++ " " ++ intercalate ", " (map showIdent is)
where f AssocLeft = "l"; f AssocRight = "r"; f AssocNone = ""
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -246,7 +246,14 @@
pImportSpec =
let
pQua = (True <$ pKeyword "qualified") <|< pure False
- in ImportSpec <$> pQua <*> pUQIdentA <*> eoptional (pKeyword "as" *> pUQIdent)
+ in ImportSpec <$> pQua <*> pUQIdentA <*> eoptional (pKeyword "as" *> pUQIdent) <*>
+ eoptional (pair <$> ((True <$ pKeyword "hiding") <|> pure False) <*> pParens (emany pImportItem))
+
+pImportItem :: P ImportItem
+pImportItem =
+ ImpTypeCon <$> (pUQIdentSym <* pSpec '(' <* pSymbol ".." <* pSpec ')')+ <|< ImpType <$> pUQIdentSym
+ <|< ImpValue <$> pLQIdentSym
--------
-- Types
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -48,7 +48,7 @@
(tds, tcs) ->
let
thisMdl = (mn, mkTModule mn tds impossible)
- impMdls = [(fromMaybe m mm, tm) | (ImportSpec _ m mm, tm) <- imps]
+ impMdls = [(fromMaybe m mm, filterImports mis tm) | (ImportSpec _ m mm mis, 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,6 +61,10 @@
fexps = [ fe | TModule _ fe _ _ _ _ <- M.elems impMap ]
in TModule mn (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
+
-- Type and value exports
getTVExps :: forall a . M.Map (TModule a) -> TypeTable -> SynTable -> ValueTable -> ExportItem ->
([TypeExport], [SynDef], [ValueExport])
@@ -156,11 +160,11 @@
let
qns aisp mn i =
case aisp of
- ImportSpec q _ mas ->
+ ImportSpec q _ mas _ ->
let
m = fromMaybe mn mas
in if q then [qualIdent m i] else [i, qualIdent m i]
- --XallValues :: M.Map [Entry]
+ allValues :: ValueTable
allValues =
let
syms arg =
@@ -175,7 +179,7 @@
case arg of
(_, TModule _ _ _ ses _ _) -> [ (i, x) | (i, x) <- ses ]
in M.fromList (concatMap syns mdls)
- --XallTypes :: TypeTable
+ allTypes :: TypeTable
allTypes =
let
types arg =
@@ -788,7 +792,7 @@
T.return (EListish (LList ees), tlist)
EListish (LCompr eret ass) -> T.do
let
- --XdoStmts :: [EStmt] -> [EStmt] -> T ([EStmt], Typed Expr)
+ doStmts :: [EStmt] -> [EStmt] -> T ([EStmt], Typed Expr)
doStmts rss xs =
case xs of
[] -> T.do
@@ -862,7 +866,7 @@
clc (e:es) os ies
doOp _ _ _ _ _ = impossible
- --Xcalc :: [Typed Expr] -> [(Typed Expr, Fixity)] -> [((Typed Expr, Fixity), Expr)] -> T (Typed Expr)
+ calc :: [Typed Expr] -> [(Typed Expr, Fixity)] -> [((Typed Expr, Fixity), Expr)] -> T (Typed Expr)
calc [et@(_, t)] [] [] = T.do munify (getSLocExpr ae) mt t; T.return et
calc es ((o, _):os) [] = doOp calc es o os []
calc es oos@((oy, (ay, py)):os) iies@((oo@(ox, (ax, px)), e) : ies) = T.do
--
⑨