b2bf654 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Fixes for issue #62: double var decls and module renames (#66)

b2bf654Andy Arvanitis6 years ago

src/CodeGen/IL.hs+1−44

compare with golang

unifiedsplit

@@ -52,10 +52,7 @@ moduleToIL

52 -> m (Text, [Text], [AST], Text, Text)

53moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =

54 do

55− let usedNames = concatMap getNames decls

56− let mnLookup = renameImports usedNames imps

57− let decls' = renameModules mnLookup decls

58− ilDecls <- mapM (bindToIL ModuleDecl) decls'

55+ ilDecls <- mapM (bindToIL ModuleDecl) decls

59 optimized <- traverse (traverse (optimize modName')) ilDecls

56 optimized <- traverse (traverse (optimize modName')) ilDecls

60 let optimized' = concat optimized

57 let optimized' = concat optimized

61 values = annotValue <$> optimized'

58 values = annotValue <$> optimized'

@@ -80,27 +77,6 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =

80 getNames (NonRec _ ident _) = [ident]

77 getNames (NonRec _ ident _) = [ident]

81 getNames (Rec vals) = map (snd . fst) vals

78 getNames (Rec vals) = map (snd . fst) vals

83− -- | Creates alternative names for each module to ensure they don't collide

84− -- with declaration names.

85− renameImports :: [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)

86− renameImports = go M.empty

87− where

88− go :: M.Map ModuleName (Ann, ModuleName) -> [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)

89− go acc used ((ann, mn') : mns') =

90− let mni = Ident $ runModuleName mn'

91− in if mn' /= mn && mni `elem` used

92− then let newName = freshModuleName 1 mn' used

93− in go (M.insert mn' (ann, newName) acc) (Ident (runModuleName newName) : used) mns'

94− else go (M.insert mn' (ann, mn') acc) used mns'

95− go acc _ [] = acc

96−

97− freshModuleName :: Integer -> ModuleName -> [Ident] -> ModuleName

98− freshModuleName i mn'@(ModuleName pns) used =

99− let newName = ModuleName $ init pns ++ [ProperName $ runProperName (last pns) <> "_" <> T.pack (show i)]

100− in if Ident (runModuleName newName) `elem` used

101− then freshModuleName (i + 1) mn' used

102− else newName

103−

104 -- | Generates IL code for a module import

80 -- | Generates IL code for a module import

105 --

81 --

106 importToIL :: AST -> [Text]

82 importToIL :: AST -> [Text]

@@ -112,25 +88,6 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =

112 extract :: Text -> Text

88 extract :: Text -> Text

113 extract = T.replace "_" "." . T.dropWhileEnd (=='_')

89 extract = T.replace "_" "." . T.dropWhileEnd (=='_')

114

115− -- | Replaces the `ModuleName`s in the AST so that the generated code refers to

116− -- the collision-avoiding renamed module imports.

117− renameModules :: M.Map ModuleName (Ann, ModuleName) -> [Bind Ann] -> [Bind Ann]

118− renameModules mnLookup binds =

119− let (f, _, _) = everywhereOnValues id ilExpr goBinder

120− in map f binds

121− where

122− ilExpr :: Expr a -> Expr a

123− ilExpr (Var ann q) = Var ann (renameQual q)

124− ilExpr e = e

125− goBinder :: Binder a -> Binder a

126− goBinder (ConstructorBinder ann q1 q2 bs) = ConstructorBinder ann (renameQual q1) (renameQual q2) bs

127− goBinder b = b

128− renameQual :: Qualified a -> Qualified a

129− renameQual (Qualified (Just mn') a) =

130− let (_,mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup

131− in Qualified (Just mnSafe) a

132− renameQual q = q

133−

134 -- |

91 -- |

135 -- Generate code in the simplified intermediate representation for a declaration

92 -- Generate code in the simplified intermediate representation for a declaration

136 --

93 --

src/CodeGen/IL/Common.hs+8−4

@@ -18,7 +18,7 @@ import qualified Language.PureScript.Constants as C

18moduleNameToIL :: ModuleName -> Text

19moduleNameToIL (ModuleName pns) =

20 let name = T.intercalate "_" (runProperName `map` pns)

21− in if nameIsILBuiltIn name then (name <> "_") else name

21+ in if nameIsILBuiltIn name then (name <> moduleRenamerMarker) else name

23moduleNameToIL' :: ModuleName -> Text

24moduleNameToIL' (ModuleName pns) = T.intercalate "." (runProperName `map` pns)

@@ -56,9 +56,10 @@ properToIL name

56-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the

57-- ordinal value.

58identCharToText :: Char -> Text

59+identCharToText 'ṩ' = "ᵤṩ"

59identCharToText c | isAlphaNum c = T.singleton c

60identCharToText c | isAlphaNum c = T.singleton c

60identCharToText '_' = "_"

61identCharToText '_' = "_"

61−identCharToText '\'' = "ʹ"

62+identCharToText '\'' = "ᵖ"

62identCharToText c = "ᵤ" <> T.pack (show (ord c))

63identCharToText c = "ᵤ" <> T.pack (show (ord c))

64moduleProperToIL :: Text -> Text

65moduleProperToIL :: Text -> Text

@@ -160,7 +161,7 @@ ilLiterals =

160 ]

161 ]

161

162

162withPrefix :: Text -> Text

163withPrefix :: Text -> Text

163−withPrefix s = "PS__" <> s

164+withPrefix s = "Ꞌ" <> s

164

165

165anyType :: Text

166anyType :: Text

166anyType = "Any"

167anyType = "Any"

@@ -198,4 +199,7 @@ copyDictFn = "CopyDict"

198freshName' :: MonadSupply m => m Text

199freshName' :: MonadSupply m => m Text

199freshName' = do

200freshName' = do

200 name <- freshName

201 name <- freshName

201− return $ T.replace "$" "ᵗ" name

202+ return $ T.replace "$" "ṩ" name

203+

204+moduleRenamerMarker :: Text

205+moduleRenamerMarker = "ᴹ"

src/CodeGen/IL/Optimizer.hs+14−1

@@ -22,10 +22,11 @@ import qualified Language.PureScript.Constants as C

22optimize :: MonadSupply m => AST -> AST -> m AST

23optimize mn il = do

24 il' <- untilFixedPoint (inlineFnComposition . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp) il

25− untilFixedPoint (return . ignoreUnusedResults . inlineCommonValues . inlineCommonOperators . tidyUp) . tco mn . inlineST

25+ il'' <- untilFixedPoint (return . ignoreUnusedResults . inlineCommonValues . inlineCommonOperators . tidyUp) . tco mn . inlineST

26 =<< untilFixedPoint (return . magicDoST)

27 =<< untilFixedPoint (return . magicDoEff)

28 =<< untilFixedPoint (return . magicDoEffect) il'

29+ untilFixedPoint (return . collapseVarDeclarations) il''

29 where

30 where

30 tidyUp :: AST -> AST

31 tidyUp :: AST -> AST

31 tidyUp = applyAll

32 tidyUp = applyAll

@@ -54,6 +55,18 @@ collapseIfChecks = everywhere collapse where

54 | prop == "otherwise" && val == "Data_Boolean" = exprs

55 | prop == "otherwise" && val == "Data_Boolean" = exprs

55 collapse exprs = exprs

56 collapse exprs = exprs

58+collapseVarDeclarations :: AST -> AST

59+collapseVarDeclarations = everywhere collapse where

60+ collapse :: AST -> AST

61+ collapse (Block ss sts) = Block ss (go Nothing sts)

62+ collapse s = s

63+

64+ go :: Maybe Text -> [AST] -> [AST]

65+ go _ [] = []

66+ go Nothing (decl@(VariableIntroduction _ var (Just _)) : sts) = decl : go (Just var) (go Nothing sts)

67+ go (Just var') ((VariableIntroduction ss var (Just val)) : sts)

68+ | var == var' = (Assignment ss (Var Nothing var) val) : go (Just var') sts

69+ go var' (s:sts) = s : go var' sts

58ignoreUnusedResults :: AST -> AST

71ignoreUnusedResults :: AST -> AST

59ignoreUnusedResults = everywhere $ removeFromBlock go

72ignoreUnusedResults = everywhere $ removeFromBlock go

src/CodeGen/IL/Printer.hs+10−4

@@ -459,7 +459,13 @@ implHeaderSource mn imports otherPrefix =

459 "type _ = Any\n\n"

460 where

461 formatImport :: Text -> Text

462+ formatImport s =

462− formatImport s = " \"" <> otherPrefix <> "/" <> modPrefix <> "/" <> s <> "\"\n"

463+ "\t\"" <> otherPrefix <> "/" <> modPrefix <> "/" <> moduleRenamer s <> "\"\n"

464+ moduleRenamer :: Text -> Text

465+ moduleRenamer s

466+ | (s', sfx) <- T.breakOn moduleRenamerMarker s,

467+ not $ T.null sfx = s'

468+ moduleRenamer s = s

463

469

464implFooterSource :: Text -> [Ident] -> Text

470implFooterSource :: Text -> [Ident] -> Text

465implFooterSource mn foreigns =

471implFooterSource mn foreigns =

@@ -487,7 +493,7 @@ implFooterSource mn foreigns =

487 mainSource :: Text

493 mainSource :: Text

488 mainSource = "\

494 mainSource = "\

489 \func main() {\n\

495 \func main() {\n\

490− \ Run(PS__main())\n\

496+ \ Run(Ꞌmain())\n\

491 \}\n\n\

497 \}\n\n\

492 \"

498 \"

493

499

@@ -516,7 +522,7 @@ ffiLoader :: Text

516ffiLoader = modLabel <> "/ffi-loader"

522ffiLoader = modLabel <> "/ffi-loader"

517

523

518initName :: Text -> Text

524initName :: Text -> Text

519−initName s = "ₒ" <> s

525+initName s = "_" <> s <> "ᵒⁿᶜᵉ"

520

526

521valueName :: Text -> Text

527valueName :: Text -> Text

522−valueName s = "ₐ" <> s

528+valueName s = "_" <> s <> "ᶠᵒʳᵉⁱᵍⁿ"