Skip to content

Commit 513ded4

Browse files
paf31paf31
committed
Merge @garyb's core functional AST changes, fixes purescript#710 
1 parent 1d06e2c commit 513ded4

34 files changed

+1162
-571
lines changed

‎examples/manual/passing/TransitiveImport.purs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
module Test where
2+
3+
class TestCls a where
4+
test :: a -> a
5+
6+
instance unitTestCls :: TestCls Unit where
7+
test _ = unit
8+
9+
module Middle where
10+
11+
middle = Test.test
12+
13+
module Main where
14+
15+
import Middle
16+
import Debug.Trace
17+
18+
main = do
19+
print (middle unit)
20+
trace "Done"
21+
return unit

‎examples/passing/ForeignInstance.purs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,10 @@ foreign import instance fooNumber :: Foo Number
99

1010
foreign import instance fooString :: Foo String
1111

12+
foreign import fooString "var fooString = {};" :: Unit
13+
foreign import fooNumber "var fooNumber = {};" :: Unit
14+
foreign import fooArray "var fooArray = {};" :: Unit
15+
1216
test1 _ = foo [1, 2, 3]
1317

1418
test2 _ = foo "Test"

‎purescript.cabal‎

Lines changed: 23 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -45,24 +45,33 @@ library
4545
Language.PureScript.AST.SourcePos
4646
Language.PureScript.AST.Traversals
4747
Language.PureScript.CodeGen
48-
Language.PureScript.CodeGen.Common
4948
Language.PureScript.CodeGen.Externs
5049
Language.PureScript.CodeGen.JS
5150
Language.PureScript.CodeGen.JS.AST
51+
Language.PureScript.CodeGen.JS.Common
52+
Language.PureScript.CodeGen.JS.Optimizer
53+
Language.PureScript.CodeGen.JS.Optimizer.Blocks
54+
Language.PureScript.CodeGen.JS.Optimizer.Common
55+
Language.PureScript.CodeGen.JS.Optimizer.Inliner
56+
Language.PureScript.CodeGen.JS.Optimizer.MagicDo
57+
Language.PureScript.CodeGen.JS.Optimizer.TCO
58+
Language.PureScript.CodeGen.JS.Optimizer.Unused
5259
Language.PureScript.Constants
60+
Language.PureScript.CoreFn
61+
Language.PureScript.CoreFn.Ann
62+
Language.PureScript.CoreFn.Binders
63+
Language.PureScript.CoreFn.Desugar
64+
Language.PureScript.CoreFn.Expr
65+
Language.PureScript.CoreFn.Literals
66+
Language.PureScript.CoreFn.Meta
67+
Language.PureScript.CoreFn.Module
68+
Language.PureScript.CoreFn.Traversals
5369
Language.PureScript.DeadCodeElimination
5470
Language.PureScript.Environment
5571
Language.PureScript.Errors
5672
Language.PureScript.Kinds
5773
Language.PureScript.ModuleDependencies
5874
Language.PureScript.Names
59-
Language.PureScript.Optimizer
60-
Language.PureScript.Optimizer.Blocks
61-
Language.PureScript.Optimizer.Common
62-
Language.PureScript.Optimizer.Inliner
63-
Language.PureScript.Optimizer.MagicDo
64-
Language.PureScript.Optimizer.TCO
65-
Language.PureScript.Optimizer.Unused
6675
Language.PureScript.Options
6776
Language.PureScript.Parser
6877
Language.PureScript.Parser.Common
@@ -106,7 +115,7 @@ library
106115
ghc-options: -Wall -O2
107116

108117
executable psc
109-
build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
118+
build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
110119
mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
111120
transformers -any, utf8-string -any
112121
main-is: Main.hs
@@ -116,8 +125,8 @@ executable psc
116125
ghc-options: -Wall -O2 -fno-warn-unused-do-bind
117126

118127
executable psc-make
119-
build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
120-
mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
128+
build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
129+
mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
121130
transformers -any, utf8-string -any
122131
main-is: Main.hs
123132
buildable: True
@@ -127,10 +136,10 @@ executable psc-make
127136

128137
executable psci
129138
build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
130-
mtl -any, optparse-applicative >= 0.10.0, parsec -any,
131-
haskeline >= 0.7.0.0, purescript -any, transformers -any,
139+
mtl -any, optparse-applicative >= 0.10.0, parsec -any,
140+
haskeline >= 0.7.0.0, purescript -any, transformers -any,
132141
utf8-string -any, process -any
133-
142+
134143
main-is: Main.hs
135144
buildable: True
136145
hs-source-dirs: psci

‎src/Language/PureScript.hs‎

Lines changed: 38 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
-----------------------------------------------------------------------------
22
--
33
-- Module : Language.PureScript
4-
-- Copyright : (c) Phil Freeman 2013
4+
-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
55
-- License : MIT
66
--
77
-- Maintainer : Phil Freeman <paf31@cantab.net>
@@ -17,42 +17,40 @@
1717

1818
module Language.PureScript (module P, compile, compile', RebuildPolicy(..), MonadMake(..), make, prelude) where
1919

20-
import Language.PureScript.Types as P
21-
import Language.PureScript.Kinds as P
20+
import Data.FileEmbed (embedFile)
21+
import Data.Function (on)
22+
import Data.List (sortBy, groupBy, intercalate)
23+
import Data.Maybe (fromMaybe)
24+
import Data.Time.Clock
25+
import qualified Data.ByteString.UTF8 as BU
26+
import qualified Data.Map as M
27+
import qualified Data.Set as S
28+
29+
import Control.Applicative
30+
import Control.Arrow ((&&&))
31+
import Control.Monad.Error
32+
33+
import System.FilePath ((</>))
34+
2235
import Language.PureScript.AST as P
36+
import Language.PureScript.CodeGen as P
37+
import Language.PureScript.DeadCodeElimination as P
38+
import Language.PureScript.Environment as P
39+
import Language.PureScript.Errors as P
40+
import Language.PureScript.Kinds as P
41+
import Language.PureScript.ModuleDependencies as P
2342
import Language.PureScript.Names as P
43+
import Language.PureScript.Options as P
2444
import Language.PureScript.Parser as P
25-
import Language.PureScript.CodeGen as P
26-
import Language.PureScript.CodeGen.Common as P
27-
import Language.PureScript.TypeChecker as P
2845
import Language.PureScript.Pretty as P
46+
import Language.PureScript.Renamer as P
2947
import Language.PureScript.Sugar as P
30-
import Language.PureScript.Options as P
31-
import Language.PureScript.ModuleDependencies as P
32-
import Language.PureScript.Environment as P
33-
import Language.PureScript.Errors as P
34-
import Language.PureScript.DeadCodeElimination as P
3548
import Language.PureScript.Supply as P
36-
import Language.PureScript.Renamer as P
37-
49+
import Language.PureScript.TypeChecker as P
50+
import Language.PureScript.Types as P
51+
import qualified Language.PureScript.CoreFn as CoreFn
3852
import qualified Language.PureScript.Constants as C
3953

40-
import Data.List (sortBy, groupBy, intercalate)
41-
import Data.Time.Clock
42-
import Data.Function (on)
43-
import Data.Maybe (fromMaybe)
44-
import Data.FileEmbed (embedFile)
45-
46-
import Control.Monad.Error
47-
import Control.Arrow ((&&&))
48-
import Control.Applicative
49-
50-
import qualified Data.Map as M
51-
import qualified Data.Set as S
52-
import qualified Data.ByteString.UTF8 as BU
53-
54-
import System.FilePath ((</>))
55-
5654
-- |
5755
-- Compile a collection of modules
5856
--
@@ -77,17 +75,18 @@ compile = compile' initEnvironment
7775

7876
compile' :: Environment -> Options Compile -> [Module] -> [String] -> Either String (String, String, Environment)
7977
compile' env opts ms prefix = do
80-
(sorted, _) <- sortModules $ map importPrim $ if optionsNoPrelude opts then ms else (map importPrelude ms)
78+
(sorted, _) <- sortModules $ map importPrim $ if optionsNoPrelude opts then ms else map importPrelude ms
8179
(desugared, nextVar) <- stringifyErrorStack True $ runSupplyT 0 $ desugar sorted
8280
(elaborated, env') <- runCheck' opts env $ forM desugared $ typeCheckModule mainModuleIdent
8381
regrouped <- stringifyErrorStack True $ createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
82+
let corefn = map (CoreFn.moduleToCoreFn env') regrouped
8483
let entryPoints = moduleNameFromString `map` entryPointModules (optionsAdditional opts)
85-
let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped
84+
let elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn
8685
let renamed = renameInModules elim
8786
let codeGenModuleNames = moduleNameFromString `map` codeGenModules (optionsAdditional opts)
88-
let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(Module mn _ _) -> mn `elem` codeGenModuleNames) renamed
89-
let js = evalSupply nextVar $ concat <$> mapM (\m -> moduleToJs opts m env') modulesToCodeGen
90-
let exts = intercalate "\n" . map (`moduleToPs` env') $ modulesToCodeGen
87+
let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed
88+
let js = evalSupply nextVar $ concat <$> mapM (moduleToJs opts) modulesToCodeGen
89+
let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
9190
js' <- generateMain env' opts js
9291
let pjs = unlines $ map ("// " ++) prefix ++ [prettyPrintJS js']
9392
return (pjs, exts, env')
@@ -156,7 +155,7 @@ make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options
156155
make outputDir opts ms prefix = do
157156
let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)
158157

159-
(sorted, graph) <- liftError $ sortModules $ map importPrim $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)
158+
(sorted, graph) <- liftError $ sortModules $ map importPrim $ if optionsNoPrelude opts then map snd ms else map (importPrelude . snd) ms
160159

161160
toRebuild <- foldM (\s (Module moduleName' _ _) -> do
162161
let filePath = runModuleName moduleName'
@@ -199,11 +198,12 @@ make outputDir opts ms prefix = do
199198
regrouped <- lift . liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
200199

201200
let mod' = Module moduleName' regrouped exps
202-
let [renamed] = renameInModules [mod']
201+
let corefn = CoreFn.moduleToCoreFn env' mod'
202+
let [renamed] = renameInModules [corefn]
203203

204-
pjs <- prettyPrintJS <$> moduleToJs opts renamed env'
204+
pjs <- prettyPrintJS <$> moduleToJs opts renamed
205205
let js = unlines $ map ("// " ++) prefix ++ [pjs]
206-
let exts = unlines $ map ("-- " ++ ) prefix ++ [moduleToPs renamed env']
206+
let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']
207207

208208
lift $ writeTextFile jsFile js
209209
lift $ writeTextFile externsFile exts

‎src/Language/PureScript/AST/Declarations.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -171,7 +171,7 @@ data Declaration
171171
-- |
172172
-- A type class instance foreign import
173173
--
174-
| ExternInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type]
174+
| ExternInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type]
175175
-- |
176176
-- A fixity declaration (fixity data, operator name)
177177
--
@@ -183,12 +183,12 @@ data Declaration
183183
-- |
184184
-- A type class declaration (name, argument, implies, member declarations)
185185
--
186-
| TypeClassDeclaration ProperName [(String, Maybe Kind)] [(Qualified ProperName, [Type])] [Declaration]
186+
| TypeClassDeclaration ProperName [(String, Maybe Kind)] [Constraint] [Declaration]
187187
-- |
188188
-- A type instance declaration (name, dependencies, class name, instance types, member
189189
-- declarations)
190190
--
191-
| TypeInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type] [Declaration]
191+
| TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] [Declaration]
192192
-- |
193193
-- A declaration with source position information
194194
--
@@ -361,7 +361,7 @@ data Expr
361361
-- at superclass implementations when searching for a dictionary, the type class name and
362362
-- instance type, and the type class dictionaries in scope.
363363
--
364-
| TypeClassDictionary Bool (Qualified ProperName, [Type]) [TypeClassDictionaryInScope]
364+
| TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
365365
-- |
366366
-- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
367367
--

‎src/Language/PureScript/CodeGen/Externs.hs‎

Lines changed: 5 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -17,21 +17,19 @@ module Language.PureScript.CodeGen.Externs (
1717
moduleToPs
1818
) where
1919

20-
import Data.Maybe (fromMaybe, mapMaybe)
2120
import Data.List (intercalate, find)
22-
21+
import Data.Maybe (fromMaybe, mapMaybe)
2322
import qualified Data.Map as M
2423

2524
import Control.Monad.Writer
2625

27-
import Language.PureScript.CodeGen.Common
28-
import Language.PureScript.TypeClassDictionaries
2926
import Language.PureScript.AST
30-
import Language.PureScript.Pretty
31-
import Language.PureScript.Names
27+
import Language.PureScript.Environment
3228
import Language.PureScript.Kinds
29+
import Language.PureScript.Names
30+
import Language.PureScript.Pretty
31+
import Language.PureScript.TypeClassDictionaries
3332
import Language.PureScript.Types
34-
import Language.PureScript.Environment
3533

3634
-- |
3735
-- Generate foreign imports for all declarations in a module
@@ -109,4 +107,3 @@ moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWrite
109107

110108
isValueExported :: Ident -> Bool
111109
isValueExported ident = ValueRef ident `elem` exts
112-

0 commit comments

Comments
 (0)