git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
swap
355eb9b46 ahead, 0 behind
.gitignore+2−2
since splitsnapshots
unifiedsplit
@@ -12,12 +12,12 @@ cabal.sandbox.config
12.test_modules/
12.test_modules/
13bower_components/
13bower_components/
14node_modules
14node_modules
15−pscpp.cabal
16−psgo.cabal
17tmp/
15tmp/
18.stack-work/
16.stack-work/
17+stack.yaml.lock
19output
18output
20examples/docs/docs/
19examples/docs/docs/
21core-tests/full-core-docs.md
20core-tests/full-core-docs.md
22.psc-ide-port
21.psc-ide-port
23.vscode/
22.vscode/
23+result
README-go.md+5−9
@@ -36,17 +36,13 @@ This assumes you are running macOS (OS X) or a Unix-like system (Linux, *BSD, et
36
36
371. Choose a working directory wherever you like. Then create a `src` subdirectory under it, which will be where you will place your own PureScript source files.
371. Choose a working directory wherever you like. Then create a `src` subdirectory under it, which will be where you will place your own PureScript source files.
38
38
39−2. Under your working directory, clone or copy [purescript-native-go-ffi](https://github.com/andyarvanitis/purescript-native-go-ffi). Place any of your own foreign implementations into subdirectories of your working directory. Make sure your Go package directories are all under a `src` directory (standard Go practice).
39+1. Initialize your project with `spago init`, and install any dependencies with `spago install` (please see their instructions if you haven't used it before).
40
40
41−3. Initialize your project with `spago init`, and install any dependencies with `spago install` (please see their instructions if you haven't used it before).
41+1. Add the `backend = "psgo"` option to your `spago.dhall` file. That way `spago` will use the psgo backend when compiling.
42
42
43−4. You should now be ready to build a PureScript program:
43+1. You should now be ready to build a PureScript program:
44− * As stated above, place your source file(s) in the working directory's `src` subdirectory and execute
44+ * As stated above, place your source file(s) in the working directory's `src` subdirectory and execute `spago build`.
45−
46− ```sh
47− spago build -- -g corefn && psgo
48− ```
49
45
50− * This will generate the Go source tree for your program and then build an executable binary. The resulting executable will be in your working directory and will be named `Main`. The generated source files will be under `output/src/`.
46+ * This will generate the Go source tree for your program and then build an executable binary. The resulting executable will be in your working directory and will be named `Main`. The generated source files will be under `output/`.
51
47
52---
48---
README.md+25−55
@@ -1,71 +1,41 @@
1[![PureScript](https://raw.githubusercontent.com/purescript/purescript/master/logo.png)](http://purescript.org)
1[![PureScript](https://raw.githubusercontent.com/purescript/purescript/master/logo.png)](http://purescript.org)
2
2
3−This is an experimental [Go](https://golang.org) compiler backend for [PureScript](https://github.com/purescript/purescript). It attempts to generate "sane", debuggable, and portable Go code as an intermediate language, which is then compiled to a native executable binary. This enables easy interoperability with existing Go frameworks and libraries on a number of platforms.
3+This is a platform-native compiler backend for [PureScript](https://github.com/purescript/purescript). It attempts to generate "sane", debuggable, and portable [C++11](https://isocpp.org/wiki/faq/cpp11) (or later) or [Go](https://golang.org/) code as an intermediate language, which is then compiled to a native executable binary. This also enables easy interoperability with existing C/C++ or Go frameworks and libraries on a number of platforms.
4
4
5−#### Platforms
5+There are two utilities in the purescript-native "suite": `pscpp` and `psgo`. The source code in this branch is for `psgo`, the purescript-to-Go transpiler. For the source code of the `pscpp` purescript-to-C++ transpiler, please see the [cpp branch](https://github.com/andyarvanitis/purescript-native/tree/cpp).
6−* Generated Go code and resulting binary executables tested (to at least some extent) on:
7− * macOS Mojave 10.14.5 (full test suite)
8− * Windows 10 x64 (full test suite)
9− * Linux Debian 10 amd64 (full test suite)
10− * ~~Raspberry Pi 3 B+ Raspbian official build (ARM)~~ (pending)
11−
12−#### Performance
13−
14−* No runtime system beyond some support types and functions
15−* Uses PureScript's normal tail call optimization techniques for generated Go code
16−
17−#### Differences from PureScript:
18−
19−* Foreign imports/exports are Go instead of JavaScript – see [standard library foreign implementations](https://github.com/andyarvanitis/purescript-native-go-ffi)
20−* No Go-specific REPL
21−
22−#### Other notes:
23−
24−* The provided `Any` type is just an alias for `interface{}`
25−* PureScript types are represented in Go with:
26
6
27− | PureScript | Go |
7+#### Platforms
28− |------------|----|
8+* Although purescript-native should work on any platform supporting PureScript and modern C++ or Go, the generated code and resulting binary executables have been tested on:
29− |`Array` | `[]Any`|
9+ * macOS Mojave 10.14.5 – full test suite
30− |`String` | `string`|
10+ * For C++, Xcode 10.2.1's `clang` was used
31− |`Number` | `float64`|
11+ * For Go, `go` version 1.12.7 was used
32− |`Int` | `int`|
12+ * Windows 10 x64 – full test suite
33− |`Char` | `string` (single UTF-8 entity)|
13+ * C++: Visual Studio 2017 and `clang`
34− |`Boolean` | `bool`|
14+ * Go: `go` version 1.12.7
35− |Records | `map[string]Any`|
15+ * Linux Debian 9.5 amd64 – full test suite (C++)
36−
16+ * Default versions of `clang` and `gcc`
37−#### Future ideas:
17+ * Linux Debian 10 amd64 – full test suite (Go)
18+ * Default version of `go`
19+ * Raspberry Pi 3 B+ Raspbian official build (ARM), default versions of `clang` and `gcc`
38
20
39−* Nice facilities (modules) for concurrency/parallelism, using goroutines
40
21
41−#### Requirements for building the compiler itself
22+#### Requirements for building `pscpp` and `psgo`
42
23
43−* [Haskell Stack](https://docs.haskellstack.org/en/stable/README/) (if you're running macOS 10.13+, you can use pre-built binaries from [here](https://github.com/andyarvanitis/purescript-native/releases/))
24+* [Haskell Stack](https://docs.haskellstack.org/en/stable/README/) (if you're running macOS 10.14.5+, you can use pre-built binaries from [here](https://github.com/andyarvanitis/purescript-native/releases/))
44
25
45−#### Requirements for using it
26+#### Requirements for using PureScript + purescript-native
46
27
47* A recent version (0.13+) of [purescript](https://github.com/purescript/purescript/releases).
28* A recent version (0.13+) of [purescript](https://github.com/purescript/purescript/releases).
48
29
30+* For `pscpp`, a C++11-capable toolchain, e.g. recent versions of clang, gcc, Microsoft Visual Studio
31+ * GNU Make + `psc-package` is the default supported build tool, but you should be able to use your favorite package manager, C++ build system, tools, debuggers, etc.
49−* The [Go toolchain](https://golang.org) for your system.
32+* For `psgo`, the [Go toolchain](https://golang.org) for your system
50−
51−* Your favorite PureScript package manager and build tools – but for simplicity these instructions will use [`spago`](https://github.com/spacchetti/spago).
33+ * You can use your favorite PureScript package manager and build tools – but for simplicity, [`spago`](https://github.com/spacchetti/spago) is recommended.
52−
53−#### Getting Started
54−This assumes you are running macOS (OS X) or a Unix-like system (Linux, *BSD, etc.).
55−
56−1. Choose a working directory wherever you like. Then create a `src` subdirectory under it, which will be where you will place your own PureScript source files.
57−
58−2. Under your working directory, clone or copy [purescript-native-go-ffi](https://github.com/andyarvanitis/purescript-native-go-ffi). Place any of your own foreign implementations into subdirectories of your working directory. Make sure your Go package directories are all under a `src` directory (standard Go practice).
59
34
60−3. Initialize your project with `spago init`, and install any dependencies with `spago install` (please see their instructions if you haven't used it before).
61
35
62−4. You should now be ready to build a PureScript program:
36+#### For more information and a Getting Started guide, please see
63− * As stated above, place your source file(s) in the working directory's `src` subdirectory and execute
37+* [`pscpp`](https://github.com/andyarvanitis/purescript-native/blob/cpp/README-cpp.md)
64−
38+* [`psgo`](https://github.com/andyarvanitis/purescript-native/blob/golang/README-go.md)
65− ```sh
66− spago build -- -g corefn && psgo
67− ```
68
39
69− * This will generate the Go source tree for your program and then build an executable binary. The resulting executable will be in your working directory and will be named `Main`. The generated source files will be under `output/src/`.
70
40
71---
41---
app/Main.hs+81−30
@@ -43,7 +43,7 @@ import CodeGen.IL.Printer
43
43
44import Tests
44import Tests
45
45
46−data Command = Build | Run
46+data Command = Build | Run (Maybe String)
47
47
48parseJson :: Text -> Value
48parseJson :: Text -> Value
49parseJson text
49parseJson text
@@ -54,12 +54,32 @@ jsonToModule :: Value -> Module Ann
54jsonToModule value =
54jsonToModule value =
55 case parse moduleFromJSON value of
55 case parse moduleFromJSON value of
56 Success (_, r) -> r
56 Success (_, r) -> r
57− _ -> error "failed"
57+ _ -> error "Failed parsing corefn. Psgo currently supports purescript <= 0.13.8"
58+
59+splitArgs :: [String] -> ([String], Maybe String, [String])
60+splitArgs args =
61+ let (opts, files) = partition (isPrefixOf "--") args
62+ opts' = (map . map) toLower opts
63+ (moduleName, files') =
64+ if null files
65+ then (Nothing, files)
66+ else
67+ if "--run" `elem` opts' && length (files) >= 1
68+ then do
69+ let file0 = head files
70+ files' = tail files
71+ case file0 of
72+ "Main.main" -> (Just "Main", files')
73+ "Test.Main.main" -> (Just "Test.Main", files')
74+ _ -> (Nothing, files)
75+ else (Nothing, files)
76+ in (opts, moduleName, files')
58
77
59main :: IO ()
78main :: IO ()
60main = do
79main = do
61 args <- getArgs
80 args <- getArgs
62− let (opts, files) = partition (isPrefixOf "--") args
81+ -- let (opts, files) = partition (isPrefixOf "--") args
82+ let (opts, moduleName, files) = splitArgs args
63 opts' = (map . map) toLower opts
83 opts' = (map . map) toLower opts
64 if "--tests" `elem` opts'
84 if "--tests" `elem` opts'
65 then runTests
85 then runTests
@@ -81,7 +101,7 @@ main = do
81 else
101 else
82 processFiles opts' files
102 processFiles opts' files
83 if "--run" `elem` opts
103 if "--run" `elem` opts
84− then runBuildTool Run
104+ then runBuildTool $ Run moduleName
85 else when ("--no-build" `notElem` opts) $
105 else when ("--no-build" `notElem` opts) $
86 runBuildTool Build
106 runBuildTool Build
87 return ()
107 return ()
@@ -109,11 +129,12 @@ main = do
109 return ()
129 return ()
110 runBuildTool :: Command -> IO ()
130 runBuildTool :: Command -> IO ()
111 runBuildTool cmd = do
131 runBuildTool cmd = do
132+ project <- projectEnv
112− let command = case cmd of
133+ case cmd of
113− Build -> "build"
134+ Build -> do
114− Run -> "run"
135+ callProcess "go" ["build", T.unpack project </> modPrefix' </> "Main"]
115− (_, _, _, p) <- createProcess (proc "go" [command, T.unpack modPrefix <> "/Main"])
136+ Run moduleName -> do
116− waitForProcess p
137+ callProcess "go" ["run", T.unpack project </> modPrefix' </> fromMaybe "Main" moduleName]
117 return ()
138 return ()
118
139
119generateCode :: [String] -> FilePath -> FilePath -> IO ()
140generateCode :: [String] -> FilePath -> FilePath -> IO ()
@@ -136,8 +157,9 @@ generateCode opts baseOutpath jsonFile = do
136transpile :: [String] -> FilePath -> FilePath -> IO ()
157transpile :: [String] -> FilePath -> FilePath -> IO ()
137transpile opts baseOutpath jsonFile = do
158transpile opts baseOutpath jsonFile = do
138 jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
159 jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
160+ project <- projectEnv
139 let module' = jsonToModule $ parseJson jsonText
161 let module' = jsonToModule $ parseJson jsonText
140− ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' Nothing)
162+ ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' project)
141 let mn = moduleNameToIL' $ moduleName module'
163 let mn = moduleNameToIL' $ moduleName module'
142 implementation = prettyPrintIL asts
164 implementation = prettyPrintIL asts
143 outpath = joinPath [baseOutpath, T.unpack mn]
165 outpath = joinPath [baseOutpath, T.unpack mn]
@@ -149,36 +171,50 @@ transpile opts baseOutpath jsonFile = do
149writeSupportFiles :: FilePath -> IO ()
171writeSupportFiles :: FilePath -> IO ()
150writeSupportFiles baseOutpath = do
172writeSupportFiles baseOutpath = do
151 currentDir <- getCurrentDirectory
173 currentDir <- getCurrentDirectory
152− let goModSource = currentDir </> "go.mod"
174+ let outputdir = T.pack $ baseOutpath \\ currentDir
153− goModSourceExists <- doesFileExist goModSource
175+ ffiOutpath = currentDir </> subdir
154− when (not goModSourceExists) $ do
155− let modText = $(embedFile "support/go.mod.working")
156− subdir = baseOutpath \\ currentDir
157− modText' = T.replace "/$OUTPUT" (T.pack subdir) $ T.decodeUtf8 modText
158− B.writeFile goModSource $ T.encodeUtf8 modText'
159 createDirectoryIfMissing True baseOutpath
176 createDirectoryIfMissing True baseOutpath
160− let goModSource = baseOutpath </> "go.mod"
177+ createDirectoryIfMissing True ffiOutpath
161− goModSourceExists <- doesFileExist goModSource
178+ writeModuleFile outputdir currentDir $(embedFile "support/go.mod.working")
162− when (not goModSourceExists) $ do
163− B.writeFile goModSource $(embedFile "support/go.mod.output")
179+ writeModuleFile outputdir baseOutpath $(embedFile "support/go.mod.output")
164− createDirectoryIfMissing True $ currentDir </> "purescript-native"
180+ writeModuleFile outputdir ffiOutpath $(embedFile "support/go.mod.ffi-loader")
181+ writeLoaderFile ffiOutpath $(embedFile "support/ffi-loader.go")
182+ where
183+ writeModuleFile :: Text -> FilePath -> B.ByteString -> IO ()
184+ writeModuleFile outputdir path modText = do
165− let goModSource = currentDir </> "purescript-native" </> "go.mod"
185+ let goModSource = path </> "go.mod"
166− goModSourceExists <- doesFileExist goModSource
186+ goModSourceExists <- doesFileExist goModSource
167− when (not goModSourceExists) $ do
187+ when (not goModSourceExists) $ do
188+ project <- projectEnv
189+ let project' = T.unpack project
190+ outputdir' = tail $ T.unpack outputdir
191+ modText' = T.replace "$PROJECT" project $ T.decodeUtf8 modText
192+ replaceLoader = project' </> ffiLoader' <> "=." </> subdir
193+ replaceOutput = project' </> modPrefix' <> "=." </> outputdir'
168− B.writeFile goModSource $(embedFile "support/go.mod.ffi-loader")
194+ B.writeFile goModSource $ T.encodeUtf8 modText'
169− let loaderSource = currentDir </> "purescript-native" </> "ffi_loader.go"
195+ callProcess "go" ["mod", "edit", "-replace", replaceLoader]
196+ callProcess "go" ["mod", "edit", "-replace", replaceOutput]
197+ callProcess "go" ["clean", "-modcache"]
198+ writeLoaderFile :: FilePath -> B.ByteString -> IO ()
199+ writeLoaderFile ffiOutpath loaderText = do
200+ let loaderSource = ffiOutpath </> "ffi_loader.go"
170− loaderSourceExists <- doesFileExist loaderSource
201+ loaderSourceExists <- doesFileExist loaderSource
171− when (not loaderSourceExists) $ do
202+ when (not loaderSourceExists) $ do
172− B.writeFile loaderSource $(embedFile "support/ffi-loader.go")
203+ B.writeFile loaderSource loaderText
173
204
174implFileName :: Text -> FilePath
205implFileName :: Text -> FilePath
175implFileName mn = ((\c -> if c == '.' then '_' else c) <$> T.unpack mn) <> ".go"
206implFileName mn = ((\c -> if c == '.' then '_' else c) <$> T.unpack mn) <> ".go"
176
207
208+projectEnv :: IO Text
209+projectEnv = do
210+ T.pack . fromMaybe defaultProject <$> lookupEnv goproject
211+
177help :: String
212help :: String
178help = "Usage: psgo OPTIONS COREFN-FILES\n\
213help = "Usage: psgo OPTIONS COREFN-FILES\n\
179 \ PureScript to native (via go) compiler\n\n\
214 \ PureScript to native (via go) compiler\n\n\
180 \Available options:\n\
215 \Available options:\n\
181 \ --help Show this help text\n\n\
216 \ --help Show this help text\n\n\
217+ \ --version Show the version number\n\n\
182 \ --run Run the generated go code directly, without building an\n\
218 \ --run Run the generated go code directly, without building an\n\
183 \ executable\n\
219 \ executable\n\
184 \ --no-build Generate go source files, but do not build an executable\n\
220 \ --no-build Generate go source files, but do not build an executable\n\
@@ -192,6 +228,21 @@ corefn = "corefn.json"
192goSrc :: String
228goSrc :: String
193goSrc = ".go"
229goSrc = ".go"
194
230
231+goproject :: String
232+goproject = "GOPROJECT"
233+
234+defaultProject :: String
235+defaultProject = "project.localhost"
236+
237+modPrefix' :: String
238+modPrefix' = T.unpack modPrefix
239+
240+ffiLoader' :: String
241+ffiLoader' = T.unpack ffiLoader
242+
243+subdir :: String
244+subdir = T.unpack modLabel
245+
195errorNoCorefnFiles :: IO ()
246errorNoCorefnFiles :: IO ()
196errorNoCorefnFiles = do
247errorNoCorefnFiles = do
197 ioError . userError $ "no compiled purescript '" <> corefn <> "' files found –\n" <>
248 ioError . userError $ "no compiled purescript '" <> corefn <> "' files found –\n" <>
default.nixnew file+23
@@ -0,0 +1,23 @@
1+let
2+ haskellNix = import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/master.tar.gz) {};
3+ nixpkgsSrc = haskellNix.sources.nixpkgs-1903; # has hsc2hs-0.68.4
4+
5+ hsc2hsOverlay = self: super: {
6+ buildPackages = super.buildPackages // {
7+ hsc2hs = super.haskellPackages.hsc2hs;
8+ };
9+ };
10+
11+ nixpkgsArgs = haskellNix.nixpkgsArgs // {
12+ overlays = haskellNix.nixpkgsArgs.overlays ++ [ hsc2hsOverlay ];
13+ };
14+in
15+{ pkgs ? import nixpkgsSrc nixpkgsArgs
16+}:
17+
18+pkgs.haskell-nix.stackProject {
19+ src = pkgs.haskell-nix.haskellLib.cleanGit {
20+ name = "purescript-native";
21+ src = ./.;
22+ };
23+}
package.yaml+6−6
@@ -24,7 +24,7 @@ description: Please see the README on Github at <https://github.com/andy
24dependencies:
24dependencies:
25- base >= 4.7 && < 5
25- base >= 4.7 && < 5
26- bytestring >= 0.10.8.2 && < 0.11
26- bytestring >= 0.10.8.2 && < 0.11
27−- purescript -any
27+- purescript
28- base-compat >=0.6.0
28- base-compat >=0.6.0
29- protolude >=0.1.6
29- protolude >=0.1.6
30- text
30- text
@@ -36,11 +36,11 @@ dependencies:
36- transformers >=0.3.0 && <0.6
36- transformers >=0.3.0 && <0.6
37- mtl >=2.1.0 && <2.3.0
37- mtl >=2.1.0 && <2.3.0
38- aeson >=1.0 && <1.5
38- aeson >=1.0 && <1.5
39−- directory -any
39+- directory
40−- process -any
40+- process
41−- file-embed -any
41+- file-embed
42−- filemanip -any
42+- filemanip
43−- gitrev -any
43+- gitrev
44
44
45library:
45library:
46 source-dirs: src
46 source-dirs: src
psgo.cabalnew file+145
@@ -0,0 +1,145 @@
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+12−50
@@ -48,21 +48,18 @@ moduleToIL
48 -- . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
48 -- . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
49 . (Monad m, MonadSupply m)
49 . (Monad m, MonadSupply m)
50 => Module Ann
50 => Module Ann
51− -> Maybe AST
51+ -> Text
52 -> m (Text, [Text], [AST], Text, Text)
52 -> m (Text, [Text], [AST], Text, Text)
53−moduleToIL (Module _ coms mn _ imps _ foreigns decls) _ =
53+moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
54 do
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'
62 foreigns' = moduleIdentToIL <$> foreigns
59 foreigns' = moduleIdentToIL <$> foreigns
63 interface = interfaceSource modName values foreigns
60 interface = interfaceSource modName values foreigns
64 imports = nub . concat $ importToIL <$> optimized'
61 imports = nub . concat $ importToIL <$> optimized'
65− implHeader = implHeaderSource modName imports ""
62+ implHeader = implHeaderSource modName imports project
66 implFooter = implFooterSource (runModuleName mn) foreigns
63 implFooter = implFooterSource (runModuleName mn) foreigns
67 return $ (interface, foreigns', optimized', implHeader, implFooter)
64 return $ (interface, foreigns', optimized', implHeader, implFooter)
68 where
65 where
@@ -80,54 +77,16 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) _ =
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
82
79
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]
107 importToIL = AST.everything (++) modRef
83 importToIL = AST.everything (++) modRef
108 where
84 where
109 modRef (AST.Indexer _ (AST.Var _ _) (AST.Var _ mname))
85 modRef (AST.Indexer _ (AST.Var _ _) (AST.Var _ mname))
110− | not $ T.null mname = [mname]
86+ | not $ T.null mname = [extract mname]
111 modRef _ = []
87 modRef _ = []
112−
88+ extract :: Text -> Text
113− -- | Replaces the `ModuleName`s in the AST so that the generated code refers to
89+ extract = T.replace "_" "." . T.dropWhileEnd (=='_')
114− -- the collision-avoiding renamed module imports.
115− renameModules :: M.Map ModuleName (Ann, ModuleName) -> [Bind Ann] -> [Bind Ann]
116− renameModules mnLookup binds =
117− let (f, _, _) = everywhereOnValues id ilExpr goBinder
118− in map f binds
119− where
120− ilExpr :: Expr a -> Expr a
121− ilExpr (Var ann q) = Var ann (renameQual q)
122− ilExpr e = e
123− goBinder :: Binder a -> Binder a
124− goBinder (ConstructorBinder ann q1 q2 bs) = ConstructorBinder ann (renameQual q1) (renameQual q2) bs
125− goBinder b = b
126− renameQual :: Qualified a -> Qualified a
127− renameQual (Qualified (Just mn') a) =
128− let (_,mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
129− in Qualified (Just mnSafe) a
130− renameQual q = q
131
90
132 -- |
91 -- |
133 -- Generate code in the simplified intermediate representation for a declaration
92 -- Generate code in the simplified intermediate representation for a declaration
@@ -178,7 +137,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) _ =
178 updates <- mapM (sndM valueToIL) ps
137 updates <- mapM (sndM valueToIL) ps
179 obj' <- freshName'
138 obj' <- freshName'
180 let objVar = AST.Var Nothing obj'
139 let objVar = AST.Var Nothing obj'
181− copy = AST.VariableIntroduction Nothing obj' (Just $ AST.App Nothing (AST.StringLiteral Nothing (mkString dictType)) [obj])
140+ copy = AST.VariableIntroduction Nothing obj' (Just $ copyDict obj)
182 assign (k, v) = AST.Assignment Nothing (accessorString k objVar) v
141 assign (k, v) = AST.Assignment Nothing (accessorString k objVar) v
183 sts = copy : (assign <$> updates) ++ [AST.Return Nothing objVar]
142 sts = copy : (assign <$> updates) ++ [AST.Return Nothing objVar]
184 return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing sts)) []
143 return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing sts)) []
@@ -242,7 +201,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) _ =
242 -- | Generate code in the simplified intermediate representation for a reference to a
201 -- | Generate code in the simplified intermediate representation for a reference to a
243 -- variable that may have a qualified name.
202 -- variable that may have a qualified name.
244 qualifiedToIL :: (a -> Ident) -> Qualified a -> AST
203 qualifiedToIL :: (a -> Ident) -> Qualified a -> AST
245− qualifiedToIL f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a
204+ qualifiedToIL f (Qualified (Just (ModuleName mn')) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a
246 qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))
205 qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))
247 qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")
206 qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")
248
207
@@ -357,3 +316,6 @@ emptyAnn = (SourceSpan "" (SourcePos 0 0) (SourcePos 0 0), [], Nothing, Nothing)
357arrayLength :: AST -> AST
316arrayLength :: AST -> AST
358arrayLength a = AST.App Nothing (AST.Var Nothing arrayLengthFn) [a]
317arrayLength a = AST.App Nothing (AST.Var Nothing arrayLengthFn) [a]
359-- arrayLength a = AST.Var Nothing (arrayLengthFn <> "(" <> prettyPrintIL1 a <> ")")
318-- arrayLength a = AST.Var Nothing (arrayLengthFn <> "(" <> prettyPrintIL1 a <> ")")
319+
320+copyDict :: AST -> AST
321+copyDict a = AST.App Nothing (AST.Var Nothing copyDictFn) [a]
src/CodeGen/IL/Common.hs+37−18
@@ -16,10 +16,12 @@ import Language.PureScript.Names
16import qualified Language.PureScript.Constants as C
16import qualified Language.PureScript.Constants as C
17
17
18moduleNameToIL :: ModuleName -> Text
18moduleNameToIL :: ModuleName -> Text
19−moduleNameToIL (ModuleName pns) = T.intercalate "_" (runProperName `map` pns)
19+moduleNameToIL (ModuleName mn) =
20+ let name = T.replace "." "_" mn
21+ in if nameIsILBuiltIn name then (name <> moduleRenamerMarker) else name
20
22
21moduleNameToIL' :: ModuleName -> Text
23moduleNameToIL' :: ModuleName -> Text
22−moduleNameToIL' (ModuleName pns) = T.intercalate "." (runProperName `map` pns)
24+moduleNameToIL' (ModuleName mn) = T.replace "_" "." mn
23
25
24-- | Convert an 'Ident' into a valid IL identifier:
26-- | Convert an 'Ident' into a valid IL identifier:
25--
27--
@@ -48,16 +50,17 @@ unusedName = "_"
48
50
49properToIL :: Text -> Text
51properToIL :: Text -> Text
50properToIL name
52properToIL name
51− | nameIsILReserved name || nameIsILBuiltIn name || prefixIsReserved name = name <> "ˉ"
53+ | nameIsILReserved name = "ˉ" <> name
52 | otherwise = T.concatMap identCharToText name
54 | otherwise = T.concatMap identCharToText name
53
55
54-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the
56-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the
55-- ordinal value.
57-- ordinal value.
56identCharToText :: Char -> Text
58identCharToText :: Char -> Text
59+identCharToText 'ṩ' = "_ṩ"
57identCharToText c | isAlphaNum c = T.singleton c
60identCharToText c | isAlphaNum c = T.singleton c
58identCharToText '_' = "_"
61identCharToText '_' = "_"
59−identCharToText '\'' = "ʹ"
62+identCharToText '\'' = "ꞌ" -- lowercase saltillo
60−identCharToText c = "ᵤ" <> T.pack (show (ord c))
63+identCharToText c = error (show (ord c)) -- TODO: should never occur now(?)
61
64
62moduleProperToIL :: Text -> Text
65moduleProperToIL :: Text -> Text
63moduleProperToIL = T.concatMap identCharToText
66moduleProperToIL = T.concatMap identCharToText
@@ -71,7 +74,21 @@ nameIsILReserved name =
71nameIsILBuiltIn :: Text -> Bool
74nameIsILBuiltIn :: Text -> Bool
72nameIsILBuiltIn name =
75nameIsILBuiltIn name =
73 name `elem`
76 name `elem`
74− [
77+ [ "Any"
78+ , "Apply"
79+ , "Contains"
80+ , "CopyDict"
81+ , "Dict"
82+ , "EffFn"
83+ , "Fn"
84+ , "Foreign"
85+ , "Get"
86+ , "Index"
87+ , "Is"
88+ , "Length"
89+ , "Once"
90+ , "Run"
91+ , "Undefined"
75 ]
92 ]
76
93
77ilAnyReserved :: [Text]
94ilAnyReserved :: [Text]
@@ -110,16 +127,6 @@ ilKeywords =
110 , "var"
127 , "var"
111 ]
128 ]
112
129
113−-- moduleIsReserved :: Text -> Bool
114−-- moduleIsReserved "Main" = False
115−-- moduleIsReserved name = not $ T.isInfixOf "_" name
116−
117−prefixIsReserved :: Text -> Bool
118−prefixIsReserved name =
119− any (`T.isPrefixOf` name)
120− [
121− ]
122−
123ilLiterals :: [Text]
130ilLiterals :: [Text]
124ilLiterals =
131ilLiterals =
125 [ "init"
132 [ "init"
@@ -145,7 +152,7 @@ ilLiterals =
145 ]
152 ]
146
153
147withPrefix :: Text -> Text
154withPrefix :: Text -> Text
148−withPrefix s = "PS__" <> s
155+withPrefix s = "Ꞌ" <> s -- uppercase saltillo
149
156
150anyType :: Text
157anyType :: Text
151anyType = "Any"
158anyType = "Any"
@@ -156,6 +163,9 @@ dictType = "Dict"
156arrayType :: Text
163arrayType :: Text
157arrayType = "[]" <> anyType
164arrayType = "[]" <> anyType
158
165
166+uncurriedFnType :: Int -> Text
167+uncurriedFnType i = "Fn" <> (T.pack . show $ i)
168+
159int :: Text
169int :: Text
160int = "int"
170int = "int"
161
171
@@ -171,7 +181,16 @@ string = "string"
171arrayLengthFn :: Text
181arrayLengthFn :: Text
172arrayLengthFn = "Length"
182arrayLengthFn = "Length"
173
183
184+indexFn :: Text
185+indexFn = "Index"
186+
187+copyDictFn :: Text
188+copyDictFn = "CopyDict"
189+
174freshName' :: MonadSupply m => m Text
190freshName' :: MonadSupply m => m Text
175freshName' = do
191freshName' = do
176 name <- freshName
192 name <- freshName
177− return $ T.replace "$" "ᵗ" name
193+ return $ T.replace "$" "ṩ" name
194+
195+moduleRenamerMarker :: Text
196+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
22optimize :: MonadSupply m => AST -> AST -> m AST
23optimize mn il = do
23optimize mn il = do
24 il' <- untilFixedPoint (inlineFnComposition . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp) il
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)
26 =<< untilFixedPoint (return . magicDoST)
27 =<< untilFixedPoint (return . magicDoEff)
27 =<< untilFixedPoint (return . magicDoEff)
28 =<< untilFixedPoint (return . magicDoEffect) il'
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
56
57
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
57
70
58ignoreUnusedResults :: AST -> AST
71ignoreUnusedResults :: AST -> AST
59ignoreUnusedResults = everywhere $ removeFromBlock go
72ignoreUnusedResults = everywhere $ removeFromBlock go
src/CodeGen/IL/Optimizer/Inliner.hs+13−4
@@ -117,12 +117,11 @@ inlineCommonOperators = everywhereTopDown $ applyAll $
117 , binary' C.dataIntBits C.xor BitwiseXor
117 , binary' C.dataIntBits C.xor BitwiseXor
118 , binary' C.dataIntBits C.shl ShiftLeft
118 , binary' C.dataIntBits C.shl ShiftLeft
119 , binary' C.dataIntBits C.shr ShiftRight
119 , binary' C.dataIntBits C.shr ShiftRight
120− , binary' C.dataIntBits C.zshr ZeroFillShiftRight
121 , unary' C.dataIntBits C.complement BitwiseNot
120 , unary' C.dataIntBits C.complement BitwiseNot
122
121
123 , inlineNonClassFunction (isModFn (C.dataFunction, C.apply)) $ \f x -> App Nothing f [x]
122 , inlineNonClassFunction (isModFn (C.dataFunction, C.apply)) $ \f x -> App Nothing f [x]
124 , inlineNonClassFunction (isModFn (C.dataFunction, C.applyFlipped)) $ \x f -> App Nothing f [x]
123 , inlineNonClassFunction (isModFn (C.dataFunction, C.applyFlipped)) $ \x f -> App Nothing f [x]
125− , inlineNonClassFunction (isModFnWithDict (C.dataArray, C.unsafeIndex)) $ flip (Indexer Nothing)
124+ , inlineUnsafeIndex (isModFnWithDict (C.dataArray, C.unsafeIndex)) $ flip (Indexer Nothing)
126 ] ++
125 ] ++
127 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ] ++
126 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ] ++
128 [ fn | i <- [0..10], fn <- [ mkEffFn C.controlMonadEffUncurried C.mkEffFn i, runEffFn C.controlMonadEffUncurried C.runEffFn i ] ] ++
127 [ fn | i <- [0..10], fn <- [ mkEffFn C.controlMonadEffUncurried C.mkEffFn i, runEffFn C.controlMonadEffUncurried C.runEffFn i ] ] ++
@@ -186,13 +185,14 @@ inlineCommonOperators = everywhereTopDown $ applyAll $
186 runFn :: Int -> AST -> AST
185 runFn :: Int -> AST -> AST
187 runFn = runFn' C.dataFunctionUncurried C.runFn (\ss f args ->
186 runFn = runFn' C.dataFunctionUncurried C.runFn (\ss f args ->
188 let len = length args
187 let len = length args
189− typ = mkString $ "Fn" <> (T.pack . show $ len) in
188+ typ = mkString $ uncurriedFnType len in
190 if len > 0
189 if len > 0
191 then App ss (App Nothing (StringLiteral Nothing typ) [f]) args
190 then App ss (App Nothing (StringLiteral Nothing typ) [f]) args
192 else App ss f args)
191 else App ss f args)
193 runEffFn :: Text -> Text -> Int -> AST -> AST
192 runEffFn :: Text -> Text -> Int -> AST -> AST
194 runEffFn modName fnName = runFn' modName fnName $ \ss fn acc ->
193 runEffFn modName fnName = runFn' modName fnName $ \ss fn acc ->
194+ let typ = mkString . uncurriedFnType $ length acc in
195− Function ss Nothing [] (Block ss [Return ss (App ss fn acc)])
195+ Function ss Nothing [] (Block ss [Return ss (App ss (App Nothing (StringLiteral Nothing typ) [fn]) acc)])
196
196
197 runFn' :: Text -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
197 runFn' :: Text -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
198 runFn' modName runFnName res n = convert where
198 runFn' modName runFnName res n = convert where
@@ -211,6 +211,15 @@ inlineCommonOperators = everywhereTopDown $ applyAll $
211 convert (App _ (App _ op' [x]) [y]) | p op' = f x y
211 convert (App _ (App _ op' [x]) [y]) | p op' = f x y
212 convert other = other
212 convert other = other
213
213
214+ inlineUnsafeIndex :: (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
215+ inlineUnsafeIndex p _ = convert where
216+ convert :: AST -> AST
217+ convert (App _ (App ss op' [x]) [y@NumericLiteral{}])
218+ | p op' = Indexer ss y x
219+ convert (App _ (App ss op' [x]) [y])
220+ | p op' = App ss (Var Nothing indexFn) [x, y]
221+ convert other = other
222+
214 isModFn :: (Text, PSString) -> AST -> Bool
223 isModFn :: (Text, PSString) -> AST -> Bool
215 isModFn (m, op) (Indexer _ (Var _ op') (Var _ m')) =
224 isModFn (m, op) (Indexer _ (Var _ op') (Var _ m')) =
216 m == m' && decodeString op == Just op'
225 m == m' && decodeString op == Just op'
src/CodeGen/IL/Optimizer/TCO.hs+5−5
@@ -12,21 +12,21 @@ import CodeGen.IL.Common
12import qualified Language.PureScript.Constants as C
12import qualified Language.PureScript.Constants as C
13
13
14tcoLoop :: Text
14tcoLoop :: Text
15−tcoLoop = "__tco_loop"
15+tcoLoop = "ṩtco_loop"
16
16
17tco :: AST -> AST -> AST
17tco :: AST -> AST -> AST
18tco mn = everywhere convert where
18tco mn = everywhere convert where
19 tcoVar :: Text -> Text
19 tcoVar :: Text -> Text
20− tcoVar arg = "__tco_var_" <> arg
20+ tcoVar arg = "ṩtco_var_" <> arg
21
21
22 copyVar :: Text -> Text
22 copyVar :: Text -> Text
23− copyVar arg = "__copy_" <> arg
23+ copyVar arg = "ṩcopy_" <> arg
24
24
25 tcoDone :: Text
25 tcoDone :: Text
26− tcoDone = "__tco_done"
26+ tcoDone = "ṩtco_done"
27
27
28 tcoResult :: Text
28 tcoResult :: Text
29− tcoResult = "__tco_result"
29+ tcoResult = "ṩtco_result"
30
30
31 convert :: AST -> AST
31 convert :: AST -> AST
32 convert fn@(Function ss (Just name) args _)
32 convert fn@(Function ss (Just name) args _)
src/CodeGen/IL/Printer.hs+32−17
@@ -7,7 +7,9 @@ module CodeGen.IL.Printer
7 , implHeaderSource
7 , implHeaderSource
8 , implFooterSource
8 , implFooterSource
9 , isLiteral
9 , isLiteral
10+ , modLabel
10 , modPrefix
11 , modPrefix
12+ , ffiLoader
11 ) where
13 ) where
12
14
13import Prelude.Compat
15import Prelude.Compat
@@ -104,6 +106,12 @@ literals = mkPattern' match'
104 , prettyPrintIL' arg
106 , prettyPrintIL' arg
105 , return $ emit ")"
107 , return $ emit ")"
106 ]
108 ]
109+ match (App _ (Var _ fn) args) | fn == indexFn = mconcat <$> sequence
110+ [ return $ emit fn
111+ , return $ emit "("
112+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
113+ , return $ emit ")"
114+ ]
107 match (App _ (Var _ fn) args) | fn == tcoLoop = mconcat <$> sequence
115 match (App _ (Var _ fn) args) | fn == tcoLoop = mconcat <$> sequence
108 [ return $ emit fn
116 [ return $ emit fn
109 , return $ emit "("
117 , return $ emit "("
@@ -226,7 +234,7 @@ literals = mkPattern' match'
226 , return $ emit "]"
234 , return $ emit "]"
227 ]
235 ]
228 match (InstanceOf _ val ty) = mconcat <$> sequence
236 match (InstanceOf _ val ty) = mconcat <$> sequence
229− [ return $ emit "Contains("
237+ [ return $ emit "Is("
230 , prettyPrintIL' val
238 , prettyPrintIL' val
231 , return $ emit ", "
239 , return $ emit ", "
232 , prettyPrintIL' ty
240 , prettyPrintIL' ty
@@ -399,8 +407,7 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
399 , [ binary Add "+"
407 , [ binary Add "+"
400 , binary Subtract "-" ]
408 , binary Subtract "-" ]
401 , [ binary ShiftLeft "<<"
409 , [ binary ShiftLeft "<<"
402− , binary ShiftRight ">>"
410+ , binary ShiftRight ">>" ]
403− , binary ZeroFillShiftRight ">>>" ]
404 , [ binary LessThan "<"
411 , [ binary LessThan "<"
405 , binary LessThanOrEqualTo "<="
412 , binary LessThanOrEqualTo "<="
406 , binary GreaterThan ">"
413 , binary GreaterThan ">"
@@ -439,20 +446,25 @@ interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
439interfaceSource _ _ _ = ""
446interfaceSource _ _ _ = ""
440
447
441implHeaderSource :: Text -> [Text] -> Text -> Text
448implHeaderSource :: Text -> [Text] -> Text -> Text
442−implHeaderSource mn imports _ =
449+implHeaderSource mn imports otherPrefix =
443− let imports' = T.replace "_" "." <$> imports in
444 "// Code generated by psgo. DO NOT EDIT.\n\n" <>
450 "// Code generated by psgo. DO NOT EDIT.\n\n" <>
445− "package " <> (if mn == "Main" then "main" else mn) <> "\n\n" <>
451+ "package " <> (if mn == "Main" || mn == "Test_Main" then "main" else mn) <> "\n\n" <>
446 "import . \"" <> runtime <> "\"\n" <>
452 "import . \"" <> runtime <> "\"\n" <>
447− (if mn == "Main"
453+ (if mn == "Main" || mn == "Test_Main"
448− then "import _ \"" <> ffiLoader <> "\"\n"
454+ then "import _ \"" <> otherPrefix <> "/" <> ffiLoader <> "\"\n"
449 else "\n") <>
455 else "\n") <>
450 "import (\n" <>
456 "import (\n" <>
451− (T.concat $ formatImport <$> imports') <> ")\n\n" <>
457+ (T.concat $ formatImport <$> imports) <> ")\n\n" <>
452 "type _ = Any\n\n"
458 "type _ = Any\n\n"
453 where
459 where
454 formatImport :: Text -> Text
460 formatImport :: Text -> Text
455− formatImport s = " \"" <> modPrefix <> "/" <> s <> "\"\n"
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
456
468
457implFooterSource :: Text -> [Ident] -> Text
469implFooterSource :: Text -> [Ident] -> Text
458implFooterSource mn foreigns =
470implFooterSource mn foreigns =
@@ -475,12 +487,12 @@ implFooterSource mn foreigns =
475 " })\n" <>
487 " })\n" <>
476 " return " <> valueName name <> "\n" <>
488 " return " <> valueName name <> "\n" <>
477 "}\n\n") <$> foreigns))) <>
489 "}\n\n") <$> foreigns))) <>
478− if mn == "Main" then mainSource else "\n"
490+ if mn == "Main" || mn == "Test.Main" then mainSource else "\n"
479 where
491 where
480 mainSource :: Text
492 mainSource :: Text
481 mainSource = "\
493 mainSource = "\
482 \func main() {\n\
494 \func main() {\n\
483− \ Run(PS__main())\n\
495+ \ Run(Ꞌmain())\n\
484 \}\n\n\
496 \}\n\n\
485 \"
497 \"
486
498
@@ -496,17 +508,20 @@ foreignMod = "Foreign"
496foreignDict :: Text
508foreignDict :: Text
497foreignDict = "foreign"
509foreignDict = "foreign"
498
510
511+modLabel :: Text
512+modLabel = "purescript-native"
513+
499modPrefix :: Text
514modPrefix :: Text
500−modPrefix = "purescript-native/output"
515+modPrefix = modLabel <> "/output"
501
516
502runtime :: Text
517runtime :: Text
503−runtime = "github.com/purescript-native/go-runtime"
518+runtime = "github.com/" <> modLabel <> "/go-runtime"
504
519
505ffiLoader :: Text
520ffiLoader :: Text
506−ffiLoader = "purescript-native/ffi-loader"
521+ffiLoader = modLabel <> "/ffi-loader"
507
522
508initName :: Text -> Text
523initName :: Text -> Text
509−initName s = "ₒ" <> s
524+initName s = "ᛌ" <> s <> "_once"
510
525
511valueName :: Text -> Text
526valueName :: Text -> Text
512−valueName s = "ₐ" <> s
527+valueName s = "ᛧ" <> s
src/Tests.hs+6−5
@@ -31,14 +31,13 @@ runTests = do
31 let srcDir = outputDir </> "src"
31 let srcDir = outputDir </> "src"
32 createDirectory srcDir
32 createDirectory srcDir
33
33
34− callProcess "git" ["clone", "--branch", "v0.13.0", "--depth", "1", "https://github.com/purescript/purescript.git"]
34+ callProcess "git" ["clone", "--branch", "v0.13.8", "--depth", "1", "https://github.com/purescript/purescript.git"]
35 let passingDir = baseDir </> "purescript" </> "tests" </> "purs" </> "passing"
35 let passingDir = baseDir </> "purescript" </> "tests" </> "purs" </> "passing"
36 passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passingDir
36 passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passingDir
37
37
38 setCurrentDirectory outputDir
38 setCurrentDirectory outputDir
39
39
40 fetchPackages
40 fetchPackages
41− callProcess "git" ["clone", "--depth", "1", "https://github.com/andyarvanitis/purescript-native-go-ffi.git"]
42
41
43 let tests = filter (`notElem` skipped) passingTestCases
42 let tests = filter (`notElem` skipped) passingTestCases
44
43
@@ -63,10 +62,9 @@ runTests = do
63
62
64 callProcess "rm" ["-rf", "output"]
63 callProcess "rm" ["-rf", "output"]
65 callProcess "rm" ["-rf", "Main"]
64 callProcess "rm" ["-rf", "Main"]
66− callProcess "spago" ["build", "--", "--codegen", "corefn"]
65+ callProcess "spago" ["build"]
67− callProcess "psgo" []
68 --
66 --
69− -- Run C++ files
67+ -- Run executable file
70 --
68 --
71 outputFile <- openFile (tmp </> logpath </> logfile) AppendMode
69 outputFile <- openFile (tmp </> logpath </> logfile) AppendMode
72 hPutStrLn outputFile ("\n" ++ inputFile ++ ":")
70 hPutStrLn outputFile ("\n" ++ inputFile ++ ":")
@@ -115,6 +113,9 @@ fetchPackages :: IO ()
115-------------------------------------------------------------------------------
113-------------------------------------------------------------------------------
116fetchPackages = do
114fetchPackages = do
117 callProcess "spago" ["init"]
115 callProcess "spago" ["init"]
116+ callCommand "sed '$s/\\(}\\)/, backend = \"psgo\"\\1/' < spago.dhall | dhall format > spago.tmp"
117+ callCommand "mv spago.tmp spago.dhall"
118+
118 mapM (callProcess "spago" . (\p -> ["install", p])) packages
119 mapM (callProcess "spago" . (\p -> ["install", p])) packages
119 return ()
120 return ()
120
121
stack.nix+18−3
@@ -1,8 +1,23 @@
1−{ pkgs ? import <nixpkgs> {}, ghc ? pkgs.ghc }:
1+#
2+# You may need to manually run `unset STACK_IN_NIX_SHELL`
3+# (doesn't work from a `shellHook`; see: https://github.com/commercialhaskell/stack/issues/5000
4+#
5+#
6+# You may need to set LC_ALL when building, e.g.
7+# LC_ALL=en_US.iso88591 stack --nix build; see e.g. https://github.com/koalaman/shellcheck/issues/324
8+#
9+#
10+{ pkgs ?
11+ import (builtins.fetchTarball {
12+ name = "nixos-release-19.03";
13+ url = https://github.com/nixos/nixpkgs/archive/34c7eb7545d155cc5b6f499b23a7cb1c96ab4d59.tar.gz;
14+ sha256 = "11z6ajj108fy2q5g8y4higlcaqncrbjm3dnv17pvif6avagw4mcb";
15+ }) {}
16+}:
2
17
3pkgs.haskell.lib.buildStackProject {
18pkgs.haskell.lib.buildStackProject {
4 name = "default-stack-shell";
19 name = "default-stack-shell";
5− inherit ghc;
20+ ghc = pkgs.haskell.compiler.ghc865;
6− buildInputs = with pkgs; [git git-lfs gmp zlib];
21+ buildInputs = with pkgs; [git git-lfs gmp ncurses zlib];
7 LANG = "en_US.UTF-8";
22 LANG = "en_US.UTF-8";
8}
23}
stack.yaml+15−65
@@ -1,74 +1,24 @@
1−# This file was automatically generated by 'stack init'
1+resolver: lts-13.26
2−#
3−# Some commonly used options have been documented as comments in this file.
4−# For advanced use and comprehensive documentation of the format, please see:
5−# https://docs.haskellstack.org/en/stable/yaml_configuration/
6
2
7−# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8−# A snapshot resolver dictates the compiler version and the set of packages
9−# to be used for project dependencies. For example:
10−#
11−# resolver: lts-3.5
12−# resolver: nightly-2015-09-21
13−# resolver: ghc-7.10.2
14−# resolver: ghcjs-0.1.0_ghc-7.10.2
15−# resolver:
16−# name: custom-snapshot
17−# location: "./custom-snapshot.yaml"
18−resolver: lts-13.12
19−
20−# User packages to be built.
21−# Various formats can be used as shown in the example below.
22−#
23−# packages:
24−# - some-directory
25−# - https://example.com/foo/bar/baz-0.0.2.tar.gz
26−# - location:
27−# git: https://github.com/commercialhaskell/stack.git
28−# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
29−# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
30−# extra-dep: true
31−# subdirs:
32−# - auto-update
33−# - wai
34−#
35−# A package marked 'extra-dep: true' will only be built if demanded by a
36−# non-dependency (i.e. a user package), and its test suites and benchmarks
37−# will not be run. This is useful for tweaking upstream packages.
38packages:
3packages:
39- .
4- .
40−# Dependency packages to be pulled from upstream that are not in the resolver
5+
41−# (e.g., acme-missiles-0.3)
42extra-deps:
6extra-deps:
43−- git: https://github.com/purescript/purescript
7+- git: https://github.com/purescript/purescript
44− commit: 738aaa2f21097c7f18aa8100b16ae52316addb04
8+ commit: 9cad73ed8ea7df3011032ddbd2f3de5a0c08629c
9+- happy-1.19.9
10+- language-javascript-0.7.0.0
45- network-3.0.1.1
11- network-3.0.1.1
46−- pipes-http-1.0.5
12+- these-1.0.1
47−
13+- semialign-1
48−# Override default flag values for local packages and extra-deps
49−# flags: {}
50−
51−# Extra package databases containing global packages
52−# extra-package-dbs: []
53−
54−# Control whether we use the GHC we find on the path
55−# system-ghc: true
56−#
57−# Require a specific version of stack, using version ranges
58−# require-stack-version: -any # Default
59−# require-stack-version: ">=1.6"
60−#
61−# Override the architecture used by stack, especially useful on Windows
62−# arch: i386
63−# arch: x86_64
64−#
65−# Extra directories used by stack for building
66−# extra-include-dirs: [/path/to/dir]
67−# extra-lib-dirs: [/path/to/dir]
68−#
69−# Allow a newer minor version of GHC than the snapshot specifies
70−# compiler-check: newer-minor
71
14
72nix:
15nix:
16+ enable: false
73 shell-file: stack.nix
17 shell-file: stack.nix
74
18
19+flags:
20+ aeson-pretty:
21+ lib-only: true
22+ these:
23+ assoc: false
24+ quickcheck: false
support/ffi-loader.go+7
@@ -8,14 +8,21 @@ import (
8 _ "github.com/purescript-native/go-ffi/purescript-assert"
8 _ "github.com/purescript-native/go-ffi/purescript-assert"
9 _ "github.com/purescript-native/go-ffi/purescript-console"
9 _ "github.com/purescript-native/go-ffi/purescript-console"
10 _ "github.com/purescript-native/go-ffi/purescript-effect"
10 _ "github.com/purescript-native/go-ffi/purescript-effect"
11+ _ "github.com/purescript-native/go-ffi/purescript-enums"
12+ _ "github.com/purescript-native/go-ffi/purescript-exceptions"
11 _ "github.com/purescript-native/go-ffi/purescript-foldable-traversable"
13 _ "github.com/purescript-native/go-ffi/purescript-foldable-traversable"
12 _ "github.com/purescript-native/go-ffi/purescript-functions"
14 _ "github.com/purescript-native/go-ffi/purescript-functions"
15+ _ "github.com/purescript-native/go-ffi/purescript-globals"
16+ _ "github.com/purescript-native/go-ffi/purescript-integers"
17+ _ "github.com/purescript-native/go-ffi/purescript-lazy"
18+ _ "github.com/purescript-native/go-ffi/purescript-math"
13 _ "github.com/purescript-native/go-ffi/purescript-partial"
19 _ "github.com/purescript-native/go-ffi/purescript-partial"
14 _ "github.com/purescript-native/go-ffi/purescript-prelude"
20 _ "github.com/purescript-native/go-ffi/purescript-prelude"
15 _ "github.com/purescript-native/go-ffi/purescript-random"
21 _ "github.com/purescript-native/go-ffi/purescript-random"
16 _ "github.com/purescript-native/go-ffi/purescript-refs"
22 _ "github.com/purescript-native/go-ffi/purescript-refs"
17 _ "github.com/purescript-native/go-ffi/purescript-st"
23 _ "github.com/purescript-native/go-ffi/purescript-st"
18 _ "github.com/purescript-native/go-ffi/purescript-strings"
24 _ "github.com/purescript-native/go-ffi/purescript-strings"
25+ _ "github.com/purescript-native/go-ffi/purescript-unfoldable"
19)
26)
20
27
21// Add your own FFI packages here.
28// Add your own FFI packages here.
support/go.mod.ffi-loader+1−1
@@ -1,2 +1,2 @@
1−module purescript-native/ffi-loader
1+module $PROJECT/purescript-native/ffi-loader
2
2
support/go.mod.output+1−1
@@ -1,2 +1,2 @@
1−module purescript-native/output
1+module $PROJECT/purescript-native/output
2
2
support/go.mod.working+1−9
@@ -1,9 +1 @@
1−module example.com/example
1+module $PROJECT/example
2−
3−require purescript-native/output v0.0.0
4−
5−replace purescript-native/output => ./$OUTPUT/
6−
7−require purescript-native/ffi-loader v0.0.0
8−
9−replace purescript-native/ffi-loader => ./purescript-native/