git.iko.soy/rowtype-yoga/purescript-native
on 7a3f114 help sign in
355eb9b
swap
0 ahead, 14 behind
13 files changed+92−204
since splitsnapshots
unifiedsplit
.gitignore+2 README.md+1−1 app/Main.hs+2−2 package.yaml+6−6 psgo.cabal−145 src/CodeGen/IL.hs+45−2 src/CodeGen/IL/Common.hs+19−14 src/CodeGen/IL/Optimizer.hs+1−14 src/CodeGen/IL/Optimizer/Inliner.hs+1 src/CodeGen/IL/Optimizer/TCO.hs+5−5 src/CodeGen/IL/Printer.hs+7−12 src/Tests.hs+2−1 stack.yaml+1−2
.gitignore+2
@@ -12,6 +12,8 @@ cabal.sandbox.config
1212.test_modules/
1313bower_components/
1414node_modules
15+pscpp.cabal
16+psgo.cabal
1517tmp/
1618.stack-work/
1719stack.yaml.lock
README.md+1−1
@@ -34,7 +34,7 @@ There are two utilities in the purescript-native "suite": `pscpp` and `psgo`. Th
3434
3535
3636#### 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)
3838* [`psgo`](https://github.com/andyarvanitis/purescript-native/blob/golang/README-go.md)
3939
4040
app/Main.hs+2−2
@@ -44,7 +44,7 @@ import CodeGen.IL.Printer
4444import Tests
4545
4646data Command = Build | Run (Maybe String)
47−
47+
4848parseJson :: Text -> Value
4949parseJson text
5050 | Just fileJson <- decode . L.encodeUtf8 $ L.fromStrict text = fileJson
@@ -54,7 +54,7 @@ jsonToModule :: Value -> Module Ann
5454jsonToModule value =
5555 case parse moduleFromJSON value of
5656 Success (_, r) -> r
57− _ -> error "Failed parsing corefn. Psgo currently supports purescript <= 0.13.8"
57+ _ -> error "failed"
5858
5959splitArgs :: [String] -> ([String], Maybe String, [String])
6060splitArgs args =
package.yaml+6−6
@@ -24,7 +24,7 @@ description: Please see the README on Github at <https://github.com/andy
2424dependencies:
2525- base >= 4.7 && < 5
2626- bytestring >= 0.10.8.2 && < 0.11
27−- purescript
27+- purescript -any
2828- base-compat >=0.6.0
2929- protolude >=0.1.6
3030- text
@@ -36,11 +36,11 @@ dependencies:
3636- transformers >=0.3.0 && <0.6
3737- mtl >=2.1.0 && <2.3.0
3838- aeson >=1.0 && <1.5
39−- directory
40−- process
41−- file-embed
42−- filemanip
43−- gitrev
39+- directory -any
40+- process -any
41+- file-embed -any
42+- filemanip -any
43+- gitrev -any
4444
4545library:
4646 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
5252 -> m (Text, [Text], [AST], Text, Text)
5353moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
5454 do
55− ilDecls <- mapM (bindToIL ModuleDecl) decls
55+ let usedNames = concatMap getNames decls
56+ let mnLookup = renameImports usedNames imps
57+ let decls' = renameModules mnLookup decls
58+ ilDecls <- mapM (bindToIL ModuleDecl) decls'
5659 optimized <- traverse (traverse (optimize modName')) ilDecls
5760 let optimized' = concat optimized
5861 values = annotValue <$> optimized'
@@ -77,6 +80,27 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
7780 getNames (NonRec _ ident _) = [ident]
7881 getNames (Rec vals) = map (snd . fst) vals
7982
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+
80104 -- | Generates IL code for a module import
81105 --
82106 importToIL :: AST -> [Text]
@@ -88,6 +112,25 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
88112 extract :: Text -> Text
89113 extract = T.replace "_" "." . T.dropWhileEnd (=='_')
90114
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+
91134 -- |
92135 -- Generate code in the simplified intermediate representation for a declaration
93136 --
@@ -201,7 +244,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
201244 -- | Generate code in the simplified intermediate representation for a reference to a
202245 -- variable that may have a qualified name.
203246 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
205248 qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))
206249 qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")
207250
src/CodeGen/IL/Common.hs+19−14
@@ -16,12 +16,12 @@ import Language.PureScript.Names
1616import qualified Language.PureScript.Constants as C
1717
1818moduleNameToIL :: ModuleName -> Text
19−moduleNameToIL (ModuleName mn) =
20− let name = T.replace "." "_" mn
21− in if nameIsILBuiltIn name then (name <> moduleRenamerMarker) else name
19+moduleNameToIL (ModuleName pns) =
20+ let name = T.intercalate "_" (runProperName `map` pns)
21+ in if nameIsILBuiltIn name then (name <> "_") else name
2222
2323moduleNameToIL' :: ModuleName -> Text
24−moduleNameToIL' (ModuleName mn) = T.replace "_" "." mn
24+moduleNameToIL' (ModuleName pns) = T.intercalate "." (runProperName `map` pns)
2525
2626-- | Convert an 'Ident' into a valid IL identifier:
2727--
@@ -50,17 +50,16 @@ unusedName = "_"
5050
5151properToIL :: Text -> Text
5252properToIL name
53− | nameIsILReserved name = "ˉ" <> name
53+ | nameIsILReserved name || nameIsILBuiltIn name || prefixIsReserved name = name <> "ˉ"
5454 | otherwise = T.concatMap identCharToText name
5555
5656-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the
5757-- ordinal value.
5858identCharToText :: Char -> Text
59−identCharToText 'ṩ' = "_ṩ"
6059identCharToText c | isAlphaNum c = T.singleton c
6160identCharToText '_' = "_"
62−identCharToText '\'' = "ꞌ" -- lowercase saltillo
63−identCharToText c = error (show (ord c)) -- TODO: should never occur now(?)
61+identCharToText '\'' = "ʹ"
62+identCharToText c = "ᵤ" <> T.pack (show (ord c))
6463
6564moduleProperToIL :: Text -> Text
6665moduleProperToIL = T.concatMap identCharToText
@@ -84,7 +83,6 @@ nameIsILBuiltIn name =
8483 , "Foreign"
8584 , "Get"
8685 , "Index"
87− , "Is"
8886 , "Length"
8987 , "Once"
9088 , "Run"
@@ -127,6 +125,16 @@ ilKeywords =
127125 , "var"
128126 ]
129127
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+
130138ilLiterals :: [Text]
131139ilLiterals =
132140 [ "init"
@@ -152,7 +160,7 @@ ilLiterals =
152160 ]
153161
154162withPrefix :: Text -> Text
155−withPrefix s = "Ꞌ" <> s -- uppercase saltillo
163+withPrefix s = "PS__" <> s
156164
157165anyType :: Text
158166anyType = "Any"
@@ -190,7 +198,4 @@ copyDictFn = "CopyDict"
190198freshName' :: MonadSupply m => m Text
191199freshName' = do
192200 name <- freshName
193− return $ T.replace "$" "ṩ" name
194−
195−moduleRenamerMarker :: Text
196−moduleRenamerMarker = "__"
201+ return $ T.replace "$" "ᵗ" name
src/CodeGen/IL/Optimizer.hs+1−14
@@ -22,11 +22,10 @@ import qualified Language.PureScript.Constants as C
2222optimize :: MonadSupply m => AST -> AST -> m AST
2323optimize mn il = do
2424 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
2626 =<< untilFixedPoint (return . magicDoST)
2727 =<< untilFixedPoint (return . magicDoEff)
2828 =<< untilFixedPoint (return . magicDoEffect) il'
29− untilFixedPoint (return . collapseVarDeclarations) il''
3029 where
3130 tidyUp :: AST -> AST
3231 tidyUp = applyAll
@@ -55,18 +54,6 @@ collapseIfChecks = everywhere collapse where
5554 | prop == "otherwise" && val == "Data_Boolean" = exprs
5655 collapse exprs = exprs
5756
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
7057
7158ignoreUnusedResults :: AST -> AST
7259ignoreUnusedResults = everywhere $ removeFromBlock go
src/CodeGen/IL/Optimizer/Inliner.hs+1
@@ -117,6 +117,7 @@ inlineCommonOperators = everywhereTopDown $ applyAll $
117117 , binary' C.dataIntBits C.xor BitwiseXor
118118 , binary' C.dataIntBits C.shl ShiftLeft
119119 , binary' C.dataIntBits C.shr ShiftRight
120+ , binary' C.dataIntBits C.zshr ZeroFillShiftRight
120121 , unary' C.dataIntBits C.complement BitwiseNot
121122
122123 , 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
1212import qualified Language.PureScript.Constants as C
1313
1414tcoLoop :: Text
15−tcoLoop = "ṩtco_loop"
15+tcoLoop = "__tco_loop"
1616
1717tco :: AST -> AST -> AST
1818tco mn = everywhere convert where
1919 tcoVar :: Text -> Text
20− tcoVar arg = "ṩtco_var_" <> arg
20+ tcoVar arg = "__tco_var_" <> arg
2121
2222 copyVar :: Text -> Text
23− copyVar arg = "ṩcopy_" <> arg
23+ copyVar arg = "__copy_" <> arg
2424
2525 tcoDone :: Text
26− tcoDone = "ṩtco_done"
26+ tcoDone = "__tco_done"
2727
2828 tcoResult :: Text
29− tcoResult = "ṩtco_result"
29+ tcoResult = "__tco_result"
3030
3131 convert :: AST -> AST
3232 convert fn@(Function ss (Just name) args _)
src/CodeGen/IL/Printer.hs+7−12
@@ -234,7 +234,7 @@ literals = mkPattern' match'
234234 , return $ emit "]"
235235 ]
236236 match (InstanceOf _ val ty) = mconcat <$> sequence
237− [ return $ emit "Is("
237+ [ return $ emit "Contains("
238238 , prettyPrintIL' val
239239 , return $ emit ", "
240240 , prettyPrintIL' ty
@@ -407,7 +407,8 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
407407 , [ binary Add "+"
408408 , binary Subtract "-" ]
409409 , [ binary ShiftLeft "<<"
410− , binary ShiftRight ">>" ]
410+ , binary ShiftRight ">>"
411+ , binary ZeroFillShiftRight ">>>" ]
411412 , [ binary LessThan "<"
412413 , binary LessThanOrEqualTo "<="
413414 , binary GreaterThan ">"
@@ -458,13 +459,7 @@ implHeaderSource mn imports otherPrefix =
458459 "type _ = Any\n\n"
459460 where
460461 formatImport :: Text -> Text
461− formatImport s =
462− "\t\"" <> otherPrefix <> "/" <> modPrefix <> "/" <> moduleRenamer 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
462+ formatImport s = " \"" <> otherPrefix <> "/" <> modPrefix <> "/" <> s <> "\"\n"
468463
469464implFooterSource :: Text -> [Ident] -> Text
470465implFooterSource mn foreigns =
@@ -492,7 +487,7 @@ implFooterSource mn foreigns =
492487 mainSource :: Text
493488 mainSource = "\
494489 \func main() {\n\
495− \ Run(Ꞌmain())\n\
490+ \ Run(PS__main())\n\
496491 \}\n\n\
497492 \"
498493
@@ -521,7 +516,7 @@ ffiLoader :: Text
521516ffiLoader = modLabel <> "/ffi-loader"
522517
523518initName :: Text -> Text
524−initName s = "ᛌ" <> s <> "_once"
519+initName s = "ₒ" <> s
525520
526521valueName :: Text -> Text
527−valueName s = "ᛧ" <> s
522+valueName s = "ₐ" <> s
src/Tests.hs+2−1
@@ -63,8 +63,9 @@ runTests = do
6363 callProcess "rm" ["-rf", "output"]
6464 callProcess "rm" ["-rf", "Main"]
6565 callProcess "spago" ["build"]
66+ callProcess "psgo" []
6667 --
67− -- Run executable file
68+ -- Run C++ files
6869 --
6970 outputFile <- openFile (tmp </> logpath </> logfile) AppendMode
7071 hPutStrLn outputFile ("\n" ++ inputFile ++ ":")
stack.yaml+1−2
@@ -5,7 +5,7 @@ packages:
55
66extra-deps:
77- git: https://github.com/purescript/purescript
8− commit: 9cad73ed8ea7df3011032ddbd2f3de5a0c08629c
8+ commit: 4dd32c48a372bb8a5250140d19af8aa18a6358d7
99- happy-1.19.9
1010- language-javascript-0.7.0.0
1111- network-3.0.1.1
@@ -13,7 +13,6 @@ extra-deps:
1313- semialign-1
1414
1515nix:
16− enable: false
1716 shell-file: stack.nix
1817
1918flags: