golang..7a3f114 · rowtype-yoga/purescript-native

.gitignore+2

since splitsnapshots

unifiedsplit

@@ -12,6 +12,8 @@ cabal.sandbox.config

12.test_modules/

13bower_components/

14node_modules

15+pscpp.cabal

16+psgo.cabal

15tmp/

17tmp/

16.stack-work/

18.stack-work/

17stack.yaml.lock

19stack.yaml.lock

README.md+1−1

@@ -34,7 +34,7 @@ There are two utilities in the purescript-native "suite": `pscpp` and `psgo`. Th

34

35

36#### For more information and a Getting Started guide, please see

37−* [`pscpp`](https://github.com/andyarvanitis/purescript-native/blob/cpp/README-cpp.md)

37+* [`pscpp`](https://github.com/andyarvanitis/purescript-native/blob/master/README-cpp.md)

38* [`psgo`](https://github.com/andyarvanitis/purescript-native/blob/golang/README-go.md)

39

40

app/Main.hs+2−2

@@ -44,7 +44,7 @@ import CodeGen.IL.Printer

44import Tests

45

46data Command = Build | Run (Maybe String)

47−

47+

48parseJson :: Text -> Value

49parseJson text

50 | Just fileJson <- decode . L.encodeUtf8 $ L.fromStrict text = fileJson

@@ -54,7 +54,7 @@ jsonToModule :: Value -> Module Ann

54jsonToModule value =

55 case parse moduleFromJSON value of

56 Success (_, r) -> r

57− _ -> error "Failed parsing corefn. Psgo currently supports purescript <= 0.13.8"

57+ _ -> error "failed"

58

59splitArgs :: [String] -> ([String], Maybe String, [String])

60splitArgs args =

package.yaml+6−6

@@ -24,7 +24,7 @@ description: Please see the README on Github at <https://github.com/andy

24dependencies:

25- base >= 4.7 && < 5

26- bytestring >= 0.10.8.2 && < 0.11

27−- purescript

27+- purescript -any

28- base-compat >=0.6.0

29- protolude >=0.1.6

30- text

@@ -36,11 +36,11 @@ dependencies:

36- transformers >=0.3.0 && <0.6

37- mtl >=2.1.0 && <2.3.0

38- aeson >=1.0 && <1.5

39−- directory

39+- directory -any

40−- process

40+- process -any

41−- file-embed

41+- file-embed -any

42−- filemanip

42+- filemanip -any

43−- gitrev

43+- gitrev -any

44

45library:

46 source-dirs: src

psgo.cabaldeleted−145

@@ -1,145 +0,0 @@

1−cabal-version: 1.12

2−

3−-- This file has been generated from package.yaml by hpack version 0.35.0.

4−--

5−-- see: https://github.com/sol/hpack

6−

7−name: psgo

8−version: 0.1.0.0

9−description: Please see the README on Github at <https://github.com/andyarvanitis/purescript-native#readme>

10−homepage: https://github.com/andyarvanitis/purescript-native#readme

11−bug-reports: https://github.com/andyarvanitis/purescript-native/issues

12−author: Andy Arvanitis

13−maintainer: example@example.com

14−copyright: 2018 Andy Arvanitis

15−license: BSD3

16−license-file: LICENSE

17−build-type: Simple

18−extra-source-files:

19− README.md

20− ChangeLog.md

21− stack.yaml

22− support/ffi-loader.go

23− support/go.mod.ffi-loader

24− support/go.mod.output

25− support/go.mod.working

26−

27−source-repository head

28− type: git

29− location: https://github.com/andyarvanitis/purescript-native

30−

31−library

32− exposed-modules:

33− CodeGen.IL

34− CodeGen.IL.Common

35− CodeGen.IL.Optimizer

36− CodeGen.IL.Optimizer.Common

37− CodeGen.IL.Optimizer.Inliner

38− CodeGen.IL.Optimizer.MagicDo

39− CodeGen.IL.Optimizer.TCO

40− CodeGen.IL.Printer

41− Tests

42− other-modules:

43− Paths_psgo

44− hs-source-dirs:

45− src

46− default-extensions:

47− ConstraintKinds

48− DataKinds

49− DeriveFunctor

50− EmptyDataDecls

51− FlexibleContexts

52− KindSignatures

53− LambdaCase

54− MultiParamTypeClasses

55− NoImplicitPrelude

56− PatternGuards

57− PatternSynonyms

58− RankNTypes

59− RecordWildCards

60− OverloadedStrings

61− ScopedTypeVariables

62− TupleSections

63− ViewPatterns

64− build-depends:

65− aeson >=1.0 && <1.5

66− , base >=4.7 && <5

67− , base-compat >=0.6.0

68− , bytestring >=0.10.8.2 && <0.11

69− , containers

70− , directory

71− , file-embed

72− , filemanip

73− , filepath

74− , gitrev

75− , monad-parallel >=0.7.2.2 && <0.8

76− , mtl >=2.1.0 && <2.3.0

77− , pattern-arrows >=0.0.2 && <0.1

78− , process

79− , protolude >=0.1.6

80− , purescript

81− , safe >=0.3.9 && <0.4

82− , text

83− , transformers >=0.3.0 && <0.6

84− default-language: Haskell2010

85−

86−executable psgo

87− main-is: Main.hs

88− other-modules:

89− Paths_psgo

90− hs-source-dirs:

91− app

92− ghc-options: -threaded -rtsopts -with-rtsopts=-N

93− build-depends:

94− aeson >=1.0 && <1.5

95− , base >=4.7 && <5

96− , base-compat >=0.6.0

97− , bytestring >=0.10.8.2 && <0.11

98− , containers

99− , directory

100− , file-embed

101− , filemanip

102− , filepath

103− , gitrev

104− , monad-parallel >=0.7.2.2 && <0.8

105− , mtl >=2.1.0 && <2.3.0

106− , pattern-arrows >=0.0.2 && <0.1

107− , process

108− , protolude >=0.1.6

109− , psgo

110− , purescript

111− , safe >=0.3.9 && <0.4

112− , text

113− , transformers >=0.3.0 && <0.6

114− default-language: Haskell2010

115−

116−test-suite psgo-test

117− type: exitcode-stdio-1.0

118− main-is: Spec.hs

119− other-modules:

120− Paths_psgo

121− hs-source-dirs:

122− test

123− ghc-options: -threaded -rtsopts -with-rtsopts=-N

124− build-depends:

125− aeson >=1.0 && <1.5

126− , base >=4.7 && <5

127− , base-compat >=0.6.0

128− , bytestring >=0.10.8.2 && <0.11

129− , containers

130− , directory

131− , file-embed

132− , filemanip

133− , filepath

134− , gitrev

135− , monad-parallel >=0.7.2.2 && <0.8

136− , mtl >=2.1.0 && <2.3.0

137− , pattern-arrows >=0.0.2 && <0.1

138− , process

139− , protolude >=0.1.6

140− , psgo

141− , purescript

142− , safe >=0.3.9 && <0.4

143− , text

144− , transformers >=0.3.0 && <0.6

145− default-language: Haskell2010

src/CodeGen/IL.hs+45−2

@@ -52,7 +52,10 @@ 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

55− ilDecls <- mapM (bindToIL ModuleDecl) decls

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

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

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

57 let optimized' = concat optimized

60 let optimized' = concat optimized

58 values = annotValue <$> optimized'

61 values = annotValue <$> optimized'

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

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

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

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

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

79

82

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+

80 -- | Generates IL code for a module import

104 -- | Generates IL code for a module import

81 --

105 --

82 importToIL :: AST -> [Text]

106 importToIL :: AST -> [Text]

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

88 extract :: Text -> Text

112 extract :: Text -> Text

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

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

90

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+

91 -- |

134 -- |

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

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

93 --

136 --

@@ -201,7 +244,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =

201 -- | Generate code in the simplified intermediate representation for a reference to a

244 -- | Generate code in the simplified intermediate representation for a reference to a

202 -- variable that may have a qualified name.

245 -- variable that may have a qualified name.

203 qualifiedToIL :: (a -> Ident) -> Qualified a -> AST

246 qualifiedToIL :: (a -> Ident) -> Qualified a -> AST

204− qualifiedToIL f (Qualified (Just (ModuleName mn')) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a

247+ qualifiedToIL f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a

205 qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))

248 qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))

206 qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")

249 qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")

207

250

src/CodeGen/IL/Common.hs+19−14

@@ -16,12 +16,12 @@ import Language.PureScript.Names

16import qualified Language.PureScript.Constants as C

17

18moduleNameToIL :: ModuleName -> Text

19−moduleNameToIL (ModuleName mn) =

19+moduleNameToIL (ModuleName pns) =

20− let name = T.replace "." "_" mn

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

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

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

22

23moduleNameToIL' :: ModuleName -> Text

24−moduleNameToIL' (ModuleName mn) = T.replace "_" "." mn

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

25

26-- | Convert an 'Ident' into a valid IL identifier:

27--

@@ -50,17 +50,16 @@ unusedName = "_"

50

51properToIL :: Text -> Text

52properToIL name

53− | nameIsILReserved name = "ˉ" <> name

53+ | nameIsILReserved name || nameIsILBuiltIn name || prefixIsReserved name = name <> "ˉ"

54 | otherwise = T.concatMap identCharToText name

55

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 'ṩ' = "_ṩ"

60identCharToText c | isAlphaNum c = T.singleton c

59identCharToText c | isAlphaNum c = T.singleton c

61identCharToText '_' = "_"

60identCharToText '_' = "_"

62−identCharToText '\'' = "ꞌ" -- lowercase saltillo

61+identCharToText '\'' = "ʹ"

63−identCharToText c = error (show (ord c)) -- TODO: should never occur now(?)

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

64

63

65moduleProperToIL :: Text -> Text

64moduleProperToIL :: Text -> Text

66moduleProperToIL = T.concatMap identCharToText

65moduleProperToIL = T.concatMap identCharToText

@@ -84,7 +83,6 @@ nameIsILBuiltIn name =

84 , "Foreign"

83 , "Foreign"

85 , "Get"

84 , "Get"

86 , "Index"

85 , "Index"

87− , "Is"

88 , "Length"

86 , "Length"

89 , "Once"

87 , "Once"

90 , "Run"

88 , "Run"

@@ -127,6 +125,16 @@ ilKeywords =

127 , "var"

125 , "var"

128 ]

126 ]

129

127

128+-- moduleIsReserved :: Text -> Bool

129+-- moduleIsReserved "Main" = False

130+-- moduleIsReserved name = not $ T.isInfixOf "_" name

131+

132+prefixIsReserved :: Text -> Bool

133+prefixIsReserved name =

134+ any (`T.isPrefixOf` name)

135+ [

136+ ]

137+

130ilLiterals :: [Text]

138ilLiterals :: [Text]

131ilLiterals =

139ilLiterals =

132 [ "init"

140 [ "init"

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

152 ]

160 ]

153

161

154withPrefix :: Text -> Text

162withPrefix :: Text -> Text

155−withPrefix s = "Ꞌ" <> s -- uppercase saltillo

163+withPrefix s = "PS__" <> s

156

164

157anyType :: Text

165anyType :: Text

158anyType = "Any"

166anyType = "Any"

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

190freshName' :: MonadSupply m => m Text

198freshName' :: MonadSupply m => m Text

191freshName' = do

199freshName' = do

192 name <- freshName

200 name <- freshName

193− return $ T.replace "$" "ṩ" name

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

194−

195−moduleRenamerMarker :: Text

196−moduleRenamerMarker = "__"

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

@@ -22,11 +22,10 @@ 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− il'' <- untilFixedPoint (return . ignoreUnusedResults . inlineCommonValues . inlineCommonOperators . tidyUp) . tco mn . inlineST

25+ 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''

30 where

29 where

31 tidyUp :: AST -> AST

30 tidyUp :: AST -> AST

32 tidyUp = applyAll

31 tidyUp = applyAll

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

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

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

56 collapse exprs = exprs

55 collapse exprs = exprs

57

56

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

70

57

71ignoreUnusedResults :: AST -> AST

58ignoreUnusedResults :: AST -> AST

72ignoreUnusedResults = everywhere $ removeFromBlock go

59ignoreUnusedResults = everywhere $ removeFromBlock go

src/CodeGen/IL/Optimizer/Inliner.hs+1

@@ -117,6 +117,7 @@ inlineCommonOperators = everywhereTopDown $ applyAll $

117 , binary' C.dataIntBits C.xor BitwiseXor

118 , binary' C.dataIntBits C.shl ShiftLeft

119 , binary' C.dataIntBits C.shr ShiftRight

120+ , binary' C.dataIntBits C.zshr ZeroFillShiftRight

120 , unary' C.dataIntBits C.complement BitwiseNot

121 , unary' C.dataIntBits C.complement BitwiseNot

121

122

122 , inlineNonClassFunction (isModFn (C.dataFunction, C.apply)) $ \f x -> App Nothing f [x]

123 , inlineNonClassFunction (isModFn (C.dataFunction, C.apply)) $ \f x -> App Nothing f [x]

src/CodeGen/IL/Optimizer/TCO.hs+5−5

@@ -12,21 +12,21 @@ import CodeGen.IL.Common

12import qualified Language.PureScript.Constants as C

13

14tcoLoop :: Text

15−tcoLoop = "ṩtco_loop"

15+tcoLoop = "__tco_loop"

16

17tco :: AST -> AST -> AST

18tco mn = everywhere convert where

19 tcoVar :: Text -> Text

20− tcoVar arg = "ṩtco_var_" <> arg

20+ tcoVar arg = "__tco_var_" <> arg

21

22 copyVar :: Text -> Text

23− copyVar arg = "ṩcopy_" <> arg

23+ copyVar arg = "__copy_" <> arg

24

25 tcoDone :: Text

26− tcoDone = "ṩtco_done"

26+ tcoDone = "__tco_done"

27

28 tcoResult :: Text

29− tcoResult = "ṩtco_result"

29+ tcoResult = "__tco_result"

30

31 convert :: AST -> AST

32 convert fn@(Function ss (Just name) args _)

src/CodeGen/IL/Printer.hs+7−12

@@ -234,7 +234,7 @@ literals = mkPattern' match'

234 , return $ emit "]"

235 ]

236 match (InstanceOf _ val ty) = mconcat <$> sequence

237− [ return $ emit "Is("

237+ [ return $ emit "Contains("

238 , prettyPrintIL' val

239 , return $ emit ", "

240 , prettyPrintIL' ty

@@ -407,7 +407,8 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue

407 , [ binary Add "+"

408 , binary Subtract "-" ]

409 , [ binary ShiftLeft "<<"

410− , binary ShiftRight ">>" ]

410+ , binary ShiftRight ">>"

411+ , binary ZeroFillShiftRight ">>>" ]

411 , [ binary LessThan "<"

412 , [ binary LessThan "<"

412 , binary LessThanOrEqualTo "<="

413 , binary LessThanOrEqualTo "<="

413 , binary GreaterThan ">"

414 , binary GreaterThan ">"

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

458 "type _ = Any\n\n"

459 "type _ = Any\n\n"

459 where

460 where

460 formatImport :: Text -> Text

461 formatImport :: Text -> Text

461− formatImport s =

462− "\t\"" <> otherPrefix <> "/" <> modPrefix <> "/" <> moduleRenamer s <> "\"\n"

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

463− moduleRenamer :: Text -> Text

464− moduleRenamer s

465− | (s', sfx) <- T.breakOn moduleRenamerMarker s,

466− not $ T.null sfx = s'

467− moduleRenamer s = s

468

463

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

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

470implFooterSource mn foreigns =

465implFooterSource mn foreigns =

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

492 mainSource :: Text

487 mainSource :: Text

493 mainSource = "\

488 mainSource = "\

494 \func main() {\n\

489 \func main() {\n\

495− \ Run(Ꞌmain())\n\

490+ \ Run(PS__main())\n\

496 \}\n\n\

491 \}\n\n\

497 \"

492 \"

498

493

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

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

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

522

517

523initName :: Text -> Text

518initName :: Text -> Text

524−initName s = "ᛌ" <> s <> "_once"

519+initName s = "ₒ" <> s

525

520

526valueName :: Text -> Text

521valueName :: Text -> Text

527−valueName s = "ᛧ" <> s

522+valueName s = "ₐ" <> s

src/Tests.hs+2−1

@@ -63,8 +63,9 @@ runTests = do

63 callProcess "rm" ["-rf", "output"]

64 callProcess "rm" ["-rf", "Main"]

65 callProcess "spago" ["build"]

66+ callProcess "psgo" []

66 --

67 --

67− -- Run executable file

68+ -- Run C++ files

68 --

69 --

69 outputFile <- openFile (tmp </> logpath </> logfile) AppendMode

70 outputFile <- openFile (tmp </> logpath </> logfile) AppendMode

70 hPutStrLn outputFile ("\n" ++ inputFile ++ ":")

71 hPutStrLn outputFile ("\n" ++ inputFile ++ ":")

stack.yaml+1−2

@@ -5,7 +5,7 @@ packages:

5

6extra-deps:

7- git: https://github.com/purescript/purescript

8− commit: 9cad73ed8ea7df3011032ddbd2f3de5a0c08629c

8+ commit: 4dd32c48a372bb8a5250140d19af8aa18a6358d7

9- happy-1.19.9

10- language-javascript-0.7.0.0

11- network-3.0.1.1

@@ -13,7 +13,6 @@ extra-deps:

13- semialign-1

14

15nix:

16− enable: false

17 shell-file: stack.nix

16 shell-file: stack.nix

18

17

19flags:

18flags: