git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge branch 'master' into nostatements
7ff5a8ePhil Freeman
RELEASE-0.2.mdnew file+85
@@ -0,0 +1,85 @@
1+## 0.2.0 Changes
2+
3+Many thanks to the [contributors](https://github.com/purescript/purescript/graphs/contributors) who helped with this release.
4+
5+- Full language guide can be found [here](http://functorial.com/purescript).
6+- Try out the latest features [here](http://tryps.functorial.com).
7+
8+### New Features
9+
10+- RankNTypes
11+
12+ This experimental feature allows polymorphic types (introduced with `forall`) to appear on the left of a function arrow, or as the type of a record field, etc. For example:
13+
14+ rank2 :: (forall a. a -> a) -> Number
15+ rank2 = \f -> if f true then f 1 else f 2
16+
17+- Modules
18+- Polymorphic Object Update
19+
20+ Records now support member update in which the type of the field changes during the update. For example:
21+
22+ data Wrap a = Wrap a
23+
24+ update = \o -> o { prop = Wrap o.prop }
25+
26+### Enhancements
27+
28+- Naked expressions as statements
29+
30+ Naked expressions of type `{}` can now be used as statements.
31+
32+- Split code generation into `AST -> JS` and `JS -> String`
33+
34+ JavaScript generation is now split into the generation of a JavaScript AST, and the pretty-printing of that AST. This enables some optimizations, and a better JavaScript pretty-printer.
35+
36+- Syntactic sugar for introducing curried functions
37+
38+ Single-argument functions and multiple-argument functions can now be introduced in the same way:
39+
40+ test = \a (b, c) d -> a + b + c + d
41+
42+- JavaScript optimizations
43+
44+ Some basic dead-variable elimination, inlining and eta-conversion are now performed on the generated JavaScript.
45+
46+- Generate formatted Javascript
47+
48+ The generated JavaScript is now formatted to be more readable. In particular, newlines get generated, and the correct indentation is used.
49+
50+- More valid infix operators
51+
52+ The colon and period characters are now valid in infix operator names.
53+
54+### Syntax Changes
55+
56+- Avoid 'do' keyword for blocks
57+
58+ `do` will be used later for Haskell-like monad comprehensions, so its previous use in introducing blocks of statements is now invalid. The `do` keyword is still reserved.
59+
60+- Member foreign import syntax
61+
62+ A small syntactic addition to the FFI, to support a common use case.
63+
64+- Make FFI syntax match Haskell
65+
66+ Use `foreign import` instead of `extern`.
67+
68+- Make record declaration syntax match Haskell
69+- Simplify array binders
70+
71+ There are now two types of array binders: cons binders `x : xs -> ...` and array binders `[x, y, z] -> ...` instead of the previously confusing `[x:xs]`.
72+
73+- Array indexing syntax is ambiguous
74+
75+ Array elements are now accessed using the `!!` operator: `arr !! 0` etc.
76+
77+### Bug Fixes
78+
79+- Allow guards access to current scope
80+
81+### Libraries
82+
83+- Prelude
84+
85+ There is now a basic prelude in the `libraries/prelude` folder.
RELEASE.md → RELEASE-0.3.mdrenamed−86
@@ -83,89 +83,3 @@ Many thanks to the [contributors](https://github.com/purescript/purescript/graph
83- A bug which caused the optimizer to break generated Javascript for mutually recursive values was fixed.
83- A bug which caused the optimizer to break generated Javascript for mutually recursive values was fixed.
84- Some `Prelude` functions which called methods in the standard Javascript library have been fixed.
84- Some `Prelude` functions which called methods in the standard Javascript library have been fixed.
85
85
86−## 0.2.0 Changes
87−
88−Many thanks to the [contributors](https://github.com/purescript/purescript/graphs/contributors) who helped with this release.
89−
90−- Full language guide can be found [here](http://functorial.com/purescript).
91−- Try out the latest features [here](http://tryps.functorial.com).
92−
93−### New Features
94−
95−- RankNTypes
96−
97− This experimental feature allows polymorphic types (introduced with `forall`) to appear on the left of a function arrow, or as the type of a record field, etc. For example:
98−
99− rank2 :: (forall a. a -> a) -> Number
100− rank2 = \f -> if f true then f 1 else f 2
101−
102−- Modules
103−- Polymorphic Object Update
104−
105− Records now support member update in which the type of the field changes during the update. For example:
106−
107− data Wrap a = Wrap a
108−
109− update = \o -> o { prop = Wrap o.prop }
110−
111−### Enhancements
112−
113−- Naked expressions as statements
114−
115− Naked expressions of type `{}` can now be used as statements.
116−
117−- Split code generation into `AST -> JS` and `JS -> String`
118−
119− JavaScript generation is now split into the generation of a JavaScript AST, and the pretty-printing of that AST. This enables some optimizations, and a better JavaScript pretty-printer.
120−
121−- Syntactic sugar for introducing curried functions
122−
123− Single-argument functions and multiple-argument functions can now be introduced in the same way:
124−
125− test = \a (b, c) d -> a + b + c + d
126−
127−- JavaScript optimizations
128−
129− Some basic dead-variable elimination, inlining and eta-conversion are now performed on the generated JavaScript.
130−
131−- Generate formatted Javascript
132−
133− The generated JavaScript is now formatted to be more readable. In particular, newlines get generated, and the correct indentation is used.
134−
135−- More valid infix operators
136−
137− The colon and period characters are now valid in infix operator names.
138−
139−### Syntax Changes
140−
141−- Avoid 'do' keyword for blocks
142−
143− `do` will be used later for Haskell-like monad comprehensions, so its previous use in introducing blocks of statements is now invalid. The `do` keyword is still reserved.
144−
145−- Member foreign import syntax
146−
147− A small syntactic addition to the FFI, to support a common use case.
148−
149−- Make FFI syntax match Haskell
150−
151− Use `foreign import` instead of `extern`.
152−
153−- Make record declaration syntax match Haskell
154−- Simplify array binders
155−
156− There are now two types of array binders: cons binders `x : xs -> ...` and array binders `[x, y, z] -> ...` instead of the previously confusing `[x:xs]`.
157−
158−- Array indexing syntax is ambiguous
159−
160− Array elements are now accessed using the `!!` operator: `arr !! 0` etc.
161−
162−### Bug Fixes
163−
164−- Allow guards access to current scope
165−
166−### Libraries
167−
168−- Prelude
169−
170− There is now a basic prelude in the `libraries/prelude` folder.
171−
RELEASE-0.4.mdnew file+60
@@ -0,0 +1,60 @@
1+## 0.4.0 Changes
2+
3+This release focussed mainly on bug fixes and minor enhancements, in order to provide a stable release of the compiler.
4+
5+This release saw major contributions from [a number of new contributors](https://github.com/purescript/purescript/graphs/contributors). Thank you very much to everyone who submitted pull requests, issues and suggestions, and also to the users of the #purescript FreeNode channel for their valuable feedback. As always, new contributors are always welcome!
6+
7+- The full language guide can be found [here](http://purescript.readthedocs.org).
8+- Try out the latest features [here](http://tryps.functorial.com).
9+
10+## Breaking Changes
11+
12+- Multiple argument functions are no longer available.
13+- When used in the browser, PureScript modules are now accessed through `window.PS.<ModuleName>`. The `PS` object name can be changed via the `--browser-namespace` compiler argument.
14+- The `--run-main` argument has been replaced with `--main` which can now accept a module name in which to find the `main` function.
15+
16+### New Features
17+
18+- Dead code elimination. The new compiler argument `--module=` can be used to specify one or more modules that should be kept in the generated code along with their dependencies. If no modules are specified, all code is exported.
19+
20+### Enhancements
21+
22+- The `->` and `[]` types are now usable in type class instances.
23+- The file path is included in syntax error messages.
24+- Most reserved Javascript names (`return`, `const`, etc) are now usable.
25+- Generated code for operators is more user friendly (for example, `Prelude[">>="]`). Where this transformation cannot be applied, human-readable variable names (e.g. `$greater$greater$eq`) are generated.
26+- The typechecker's function application judgement was greatly simplified, and as a result, more valid things now typecheck.
27+- Data constructors with multiple arguments can now be defined.
28+- It is no longer necessary to sort modules in order of dependencies manually.
29+- Case statements matching data constructors no longer generate unnecessary constructor checks at runtime if there is only a single data constructor.
30+- New optimizer rules were added to inline JavaScript's built-in operators.
31+
32+### Bug Fixes
33+
34+- Floats parse correctly.
35+- Using data constructors in pattern matches now works properly across modules.
36+- PureScript modules no longer overwrite global objects with the same name.
37+- Show problems with shadowing of names were fixed.
38+- Problems with recursive non-function values were fixed.
39+- Type synonyms can now expand to types containing more type synonyms.
40+- A bug in capture-avoiding type variable substitution which was affecting the `Functor (Either e)` instance was fixed.
41+- Type synonym instances are now disallowed.
42+- Precedence rules for some basic operators were corrected.
43+- A bug which allowed skolem variables to escape their scope was add (thanks to Brian McKenna).
44+- Modules containing mutually recursive type synonyms and data declarations now compile correctly.
45+- A number of bugs in the optimizer were addressed.
46+
47+### Libraries
48+
49+- The `Prelude` has been greatly expanded. Definitions for built-in JavaScript operators have been moved into the Prelude.
50+- Gary Burgess has released the [grunt-purescript library](https://github.com/purescript/grunt-purescript) to build PureScript code using Grunt.
51+- The [purescript-parsing](https://github.com/purescript/purescript-parsing) library provides Parsec-like parsing combinators.
52+- The [purescript-promises](https://github.com/purescript/purescript-promises) library provides `Monad` and `Applicative` instances for promises.
53+- The [purescript-quickcheck](https://github.com/purescript/purescript-quickcheck) library provides a very basic implementation of a QuickCheck-style testing harness.
54+- The [purescript-json](https://github.com/purescript/purescript-json) library aims to provide a safe way to consume JSON data.
55+
56+### Documentation
57+
58+- Documentation for the `Prelude` modules is now automatically generated and can be found [here](http://purescript.readthedocs.org/en/latest/prelude.html).
59+- There is now Hackage documentation.
60+- Code comments have been improved.
RELEASE-0.5.mdnew file+25
@@ -0,0 +1,25 @@
1+## 0.5.0 Changes
2+
3+## Breaking Changes
4+
5+-
6+
7+### New Features
8+
9+-
10+
11+### Enhancements
12+
13+- Pretty printing for row types was improved (garyb)
14+
15+### Bug Fixes
16+
17+-
18+
19+### Libraries
20+
21+-
22+
23+### Documentation
24+
25+-
docs/source/conf.py+2−2
@@ -51,9 +51,9 @@ copyright = u'2014, Phil Freeman'
51# built documents.
51# built documents.
52#
52#
53# The short X.Y version.
53# The short X.Y version.
54−version = '0.3.1'
54+version = '0.4.0'
55# The full version, including alpha/beta/rc tags.
55# The full version, including alpha/beta/rc tags.
56−release = '0.3.1'
56+release = '0.4.0'
57
57
58# The language for content autogenerated by Sphinx. Refer to documentation
58# The language for content autogenerated by Sphinx. Refer to documentation
59# for a list of supported languages.
59# for a list of supported languages.
docs/source/intro.rst+2−2
@@ -47,9 +47,9 @@ The following options are supported:
47--tco Perform tail-call elimination on the generated Javascript.
47--tco Perform tail-call elimination on the generated Javascript.
48--no-prelude Do not include the Prelude in the generated Javascript.
48--no-prelude Do not include the Prelude in the generated Javascript.
49--magic-do Overload the `do` keyword to inline calls to `bind` for the `Eff` monad, to generate more efficient code.
49--magic-do Overload the `do` keyword to inline calls to `bind` for the `Eff` monad, to generate more efficient code.
50−--run-main Generate a call to `Main.main` after all other generated Javascript.
50+--main Generate a call to `main` in the specified module after all other generated Javascript. Defaults to `Main` if the option is used but no value is provided.
51+--module If specified, any code which is not referenced transitively from this module will be removed. This argument can be used multiple times.
51--browser-namespace Specify the namespace that PureScript modules will be exported to when running in the browser.
52--browser-namespace Specify the namespace that PureScript modules will be exported to when running in the browser.
52−--entry-point Specify the entry-point module (usually Main). If specified, code which is not referenced transitively from this module will be removed.
53
53
54Motivation
54Motivation
55----------
55----------
examples/failing/Object.pursnew file+5
@@ -0,0 +1,5 @@
1+module Object where
2+
3+test o = o.foo
4+
5+test1 = test {}
prelude/prelude.purs+3−3
@@ -56,7 +56,7 @@ module Prelude where
56 read _ = false
56 read _ = false
57
57
58 foreign import readNumber "function readNumber(n) {\
58 foreign import readNumber "function readNumber(n) {\
59− \ return parseInt(n, 10);\
59+ \ return parseFloat(n);\
60 \}" :: String -> Number
60 \}" :: String -> Number
61
61
62 instance Read Number where
62 instance Read Number where
@@ -164,13 +164,13 @@ module Prelude where
164
164
165 foreign import refEq "function refEq(r1) {\
165 foreign import refEq "function refEq(r1) {\
166 \ return function(r2) {\
166 \ return function(r2) {\
167− \ return r1.value === r2.value;\
167+ \ return r1.values[0] === r2.values[0];\
168 \ };\
168 \ };\
169 \}" :: forall a. Ref a -> Ref a -> Boolean
169 \}" :: forall a. Ref a -> Ref a -> Boolean
170
170
171 foreign import refIneq "function refIneq(r1) {\
171 foreign import refIneq "function refIneq(r1) {\
172 \ return function(r2) {\
172 \ return function(r2) {\
173− \ return r1.value !== r2.value;\
173+ \ return r1.values[0] !== r2.values[0];\
174 \ };\
174 \ };\
175 \}" :: forall a. Ref a -> Ref a -> Boolean
175 \}" :: forall a. Ref a -> Ref a -> Boolean
176
176
psc/Main.hs+7−7
@@ -86,9 +86,9 @@ magicDo :: Term Bool
86magicDo = value $ flag $ (optInfo [ "magic-do" ])
86magicDo = value $ flag $ (optInfo [ "magic-do" ])
87 { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }
87 { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }
88
88
89−runMain :: Term Bool
89+runMain :: Term (Maybe String)
90−runMain = value $ flag $ (optInfo [ "run-main" ])
90+runMain = value $ defaultOpt (Just "Main") Nothing $ (optInfo [ "main" ])
91− { optDoc = "Generate code to run the main method in the Main module." }
91+ { optDoc = "Generate code to run the main method in the specified module." }
92
92
93noOpts :: Term Bool
93noOpts :: Term Bool
94noOpts = value $ flag $ (optInfo [ "no-opts" ])
94noOpts = value $ flag $ (optInfo [ "no-opts" ])
@@ -98,12 +98,12 @@ browserNamespace :: Term String
98browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
98browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
99 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
99 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
100
100
101−entryPoint :: Term (Maybe String)
101+dceModules :: Term [String]
102−entryPoint = value $ opt Nothing $ (optInfo [ "entry-point" ])
102+dceModules = value $ optAll [] $ (optInfo [ "m", "module" ])
103− { optDoc = "Specify the module which is the entry point. All code which is not a transitive dependency of this module will be removed." }
103+ { optDoc = "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times." }
104
104
105options :: Term P.Options
105options :: Term P.Options
106−options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> entryPoint
106+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules
107
107
108stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
108stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
109stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
109stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
psci/Main.hs+1−1
@@ -35,7 +35,7 @@ getPreludeFilename :: IO FilePath
35getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
35getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
36
36
37options :: P.Options
37options :: P.Options
38−options = P.Options True False True True True "PS" Nothing
38+options = P.Options True False True Nothing True "PS" []
39
39
40completion :: [P.Module] -> CompletionFunc IO
40completion :: [P.Module] -> CompletionFunc IO
41completion ms = completeWord Nothing " \t\n\r" findCompletions
41completion ms = completeWord Nothing " \t\n\r" findCompletions
purescript.cabal+1−1
@@ -1,5 +1,5 @@
1name: purescript
1name: purescript
2−version: 0.3.14
2+version: 0.4.1
3cabal-version: >=1.8
3cabal-version: >=1.8
4build-type: Simple
4build-type: Simple
5license: MIT
5license: MIT
src/Language/PureScript.hs+15−13
@@ -30,10 +30,10 @@ import Language.PureScript.ModuleDependencies as P
30import Language.PureScript.DeadCodeElimination as P
30import Language.PureScript.DeadCodeElimination as P
31
31
32import Data.List (intercalate)
32import Data.List (intercalate)
33−import Data.Maybe (mapMaybe)
33+import Data.Maybe (mapMaybe, fromMaybe)
34import Control.Monad (when, forM)
34import Control.Monad (when, forM)
35import Control.Monad.State.Lazy
35import Control.Monad.State.Lazy
36−import Control.Applicative ((<$>))
36+import Control.Applicative ((<$>), (<|>))
37import qualified Data.Map as M
37import qualified Data.Map as M
38
38
39-- |
39-- |
@@ -47,9 +47,9 @@ import qualified Data.Map as M
47--
47--
48-- * Type check, and elaborate values to include type annotations and type class dictionaries.
48-- * Type check, and elaborate values to include type annotations and type class dictionaries.
49--
49--
50−-- * Regroup values to take into account new value dependencies introduced by elaboration
50+-- * Regroup values to take into account new value dependencies introduced by elaboration.
51--
51--
52−-- * Eliminate dead code
52+-- * Eliminate dead code.
53--
53--
54-- * Generate Javascript, and perform optimization passes.
54-- * Generate Javascript, and perform optimization passes.
55--
55--
@@ -61,16 +61,18 @@ compile opts ms = do
61 desugared <- desugar sorted
61 desugared <- desugar sorted
62 (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName decls) -> do
62 (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName decls) -> do
63 modify (\s -> s { checkCurrentModule = Just (ModuleName moduleName) })
63 modify (\s -> s { checkCurrentModule = Just (ModuleName moduleName) })
64− Module moduleName <$> typeCheckAll (ModuleName moduleName) decls
64+ Module moduleName <$> typeCheckAll mainModuleIdent (ModuleName moduleName) decls
65 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
65 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
66− let entryPoint = optionsEntryPoint opts
66+ let entryPoints = optionsModules opts
67− let elim = maybe regrouped (\ep -> eliminateDeadCode env ep regrouped) entryPoint
67+ let elim = if null entryPoints then regrouped else eliminateDeadCode env entryPoints regrouped
68 let js = mapMaybe (flip (moduleToJs opts) env) elim
68 let js = mapMaybe (flip (moduleToJs opts) env) elim
69 let exts = intercalate "\n" . map (flip moduleToPs env) $ elim
69 let exts = intercalate "\n" . map (flip moduleToPs env) $ elim
70− js' <- case () of
70+ js' <- case optionsMain opts of
71− _ | optionsRunMain opts -> do
71+ Just mainModuleName -> do
72− when ((ModuleName (ProperName "Main"), Ident "main") `M.notMember` (names env)) $
72+ when ((ModuleName (ProperName mainModuleName), Ident "main") `M.notMember` (names env)) $
73− Left "Main.main is undefined"
73+ Left $ mainModuleName ++ ".main is undefined"
74− return $ js ++ [JSApp (JSAccessor "main" (JSAccessor "Main" (JSVar "_ps"))) []]
74+ return $ js ++ [JSApp (JSAccessor "main" (JSAccessor mainModuleName (JSVar "_ps"))) []]
75− | otherwise -> return js
75+ _ -> return js
76 return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)
76 return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)
77+ where
78+ mainModuleIdent = ModuleName . ProperName <$> (optionsMain opts)
src/Language/PureScript/DeadCodeElimination.hs+3−3
@@ -30,11 +30,11 @@ import Language.PureScript.TypeChecker.Monad
30-- |
30-- |
31-- Eliminate all declarations which are not a transitive dependency of the entry point module
31-- Eliminate all declarations which are not a transitive dependency of the entry point module
32--
32--
33−eliminateDeadCode :: Environment -> String -> [Module] -> [Module]
33+eliminateDeadCode :: Environment -> [String] -> [Module] -> [Module]
34−eliminateDeadCode env entryPoint ms =
34+eliminateDeadCode env entryPoints ms =
35 let declarations = concatMap (declarationsByModule env) ms
35 let declarations = concatMap (declarationsByModule env) ms
36 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
36 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
37− entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((ModuleName (ProperName mn), _), _) -> mn == entryPoint) $ declarations
37+ entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((ModuleName (ProperName mn), _), _) -> mn `elem` entryPoints) $ declarations
38 in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed (ModuleName moduleName) graph vertexFor entryPointVertices) ds)
38 in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed (ModuleName moduleName) graph vertexFor entryPointVertices) ds)
39
39
40type Key = (ModuleName, Either Ident ProperName)
40type Key = (ModuleName, Either Ident ProperName)
src/Language/PureScript/Options.hs+6−5
@@ -32,9 +32,10 @@ data Options = Options {
32 --
32 --
33 , optionsMagicDo :: Bool
33 , optionsMagicDo :: Bool
34 -- |
34 -- |
35− -- Check the type of Main.main and generate its code
35+ -- When specified, checks the type of `main` in the module, and generate a call to run main
36+ -- after the module definitions.
36 --
37 --
37− , optionsRunMain :: Bool
38+ , optionsMain :: Maybe String
38 -- |
39 -- |
39 -- Skip all optimizations
40 -- Skip all optimizations
40 --
41 --
@@ -45,13 +46,13 @@ data Options = Options {
45 --
46 --
46 , optionsBrowserNamespace :: String
47 , optionsBrowserNamespace :: String
47 -- |
48 -- |
48− -- The entry point module, for dead code elimination
49+ -- The modules to keep while enabling dead code elimination
49 --
50 --
50− , optionsEntryPoint :: Maybe String
51+ , optionsModules :: [String]
51 } deriving Show
52 } deriving Show
52
53
53-- |
54-- |
54-- Default compiler options
55-- Default compiler options
55--
56--
56defaultOptions :: Options
57defaultOptions :: Options
57−defaultOptions = Options False False False False False "PS" Nothing
58+defaultOptions = Options False False False Nothing False "PS" []
src/Language/PureScript/Pretty/Types.hs+3−3
@@ -32,7 +32,7 @@ import Language.PureScript.Pretty.Common
32typeLiterals :: Pattern () Type String
32typeLiterals :: Pattern () Type String
33typeLiterals = mkPattern match
33typeLiterals = mkPattern match
34 where
34 where
35− match (Object row) = Just $ "{ " ++ prettyPrintType row ++ " }"
35+ match (Object row) = Just $ "{ " ++ prettyPrintRow row ++ " }"
36 match (TypeVar var) = Just var
36 match (TypeVar var) = Just var
37 match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"
37 match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"
38 match ty@(TypeConstructor ctor) = Just $ show ctor
38 match ty@(TypeConstructor ctor) = Just $ show ctor
@@ -41,8 +41,8 @@ typeLiterals = mkPattern match
41 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate "," (map (\(pn, ty') -> show pn ++ " (" ++ prettyPrintType ty' ++ ")") deps) ++ ") => " ++ prettyPrintType ty
41 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate "," (map (\(pn, ty') -> show pn ++ " (" ++ prettyPrintType ty' ++ ")") deps) ++ ") => " ++ prettyPrintType ty
42 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintType args) ++ ">"
42 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintType args) ++ ">"
43 match (ForAll ident ty _) = Just $ "forall " ++ ident ++ ". " ++ prettyPrintType ty
43 match (ForAll ident ty _) = Just $ "forall " ++ ident ++ ". " ++ prettyPrintType ty
44− match REmpty = Just $ prettyPrintRow REmpty
44+ match REmpty = Just "()"
45− match row@(RCons _ _ _) = Just $ prettyPrintRow row
45+ match row@(RCons _ _ _) = Just $ '(' : prettyPrintRow row ++ ")"
46 match _ = Nothing
46 match _ = Nothing
47
47
48-- |
48-- |
src/Language/PureScript/TypeChecker.hs+28−28
@@ -111,16 +111,16 @@ checkTypeClassInstance _ _ = throwError "Type class instance must be of the form
111--
111--
112-- * Process module imports
112-- * Process module imports
113--
113--
114−typeCheckAll :: ModuleName -> [Declaration] -> Check [Declaration]
114+typeCheckAll :: Maybe ModuleName -> ModuleName -> [Declaration] -> Check [Declaration]
115−typeCheckAll _ [] = return []
115+typeCheckAll _ _ [] = return []
116−typeCheckAll moduleName (d@(DataDeclaration name args dctors) : rest) = do
116+typeCheckAll mainModuleName moduleName (d@(DataDeclaration name args dctors) : rest) = do
117 rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do
117 rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do
118 typeIsNotDefined moduleName name
118 typeIsNotDefined moduleName name
119 ctorKind <- kindsOf moduleName name args (concatMap snd dctors)
119 ctorKind <- kindsOf moduleName name args (concatMap snd dctors)
120 addDataType moduleName name args dctors ctorKind
120 addDataType moduleName name args dctors ctorKind
121− ds <- typeCheckAll moduleName rest
121+ ds <- typeCheckAll mainModuleName moduleName rest
122 return $ d : ds
122 return $ d : ds
123−typeCheckAll moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
123+typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
124 rethrow ("Error in data binding group:\n" ++) $ do
124 rethrow ("Error in data binding group:\n" ++) $ do
125 let syns = mapMaybe toTypeSynonym tys
125 let syns = mapMaybe toTypeSynonym tys
126 let dataDecls = mapMaybe toDataDecl tys
126 let dataDecls = mapMaybe toDataDecl tys
@@ -131,48 +131,48 @@ typeCheckAll moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
131 forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do
131 forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do
132 typeIsNotDefined moduleName name
132 typeIsNotDefined moduleName name
133 addTypeSynonym moduleName name args ty kind
133 addTypeSynonym moduleName name args ty kind
134− ds <- typeCheckAll moduleName rest
134+ ds <- typeCheckAll mainModuleName moduleName rest
135 return $ d : ds
135 return $ d : ds
136 where
136 where
137 toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)
137 toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)
138 toTypeSynonym _ = Nothing
138 toTypeSynonym _ = Nothing
139 toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)
139 toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)
140 toDataDecl _ = Nothing
140 toDataDecl _ = Nothing
141−typeCheckAll moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
141+typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
142 rethrow (("Error in type synonym " ++ show name ++ ":\n") ++) $ do
142 rethrow (("Error in type synonym " ++ show name ++ ":\n") ++) $ do
143 typeIsNotDefined moduleName name
143 typeIsNotDefined moduleName name
144 kind <- kindsOf moduleName name args [ty]
144 kind <- kindsOf moduleName name args [ty]
145 addTypeSynonym moduleName name args ty kind
145 addTypeSynonym moduleName name args ty kind
146− ds <- typeCheckAll moduleName rest
146+ ds <- typeCheckAll mainModuleName moduleName rest
147 return $ d : ds
147 return $ d : ds
148−typeCheckAll _ (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
148+typeCheckAll _ _ (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
149−typeCheckAll moduleName (ValueDeclaration name [] Nothing val : rest) = do
149+typeCheckAll mainModuleName moduleName (ValueDeclaration name [] Nothing val : rest) = do
150 d <- rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do
150 d <- rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do
151 valueIsNotDefined moduleName name
151 valueIsNotDefined moduleName name
152− [(_, (val', ty))] <- typesOf moduleName [(name, val)]
152+ [(_, (val', ty))] <- typesOf mainModuleName moduleName [(name, val)]
153 addValue moduleName name ty
153 addValue moduleName name ty
154 return $ ValueDeclaration name [] Nothing val'
154 return $ ValueDeclaration name [] Nothing val'
155− ds <- typeCheckAll moduleName rest
155+ ds <- typeCheckAll mainModuleName moduleName rest
156 return $ d : ds
156 return $ d : ds
157−typeCheckAll _ (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
157+typeCheckAll _ _ (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
158−typeCheckAll moduleName (BindingGroupDeclaration vals : rest) = do
158+typeCheckAll mainModuleName moduleName (BindingGroupDeclaration vals : rest) = do
159 d <- rethrow (("Error in binding group " ++ show (map fst vals) ++ ":\n") ++) $ do
159 d <- rethrow (("Error in binding group " ++ show (map fst vals) ++ ":\n") ++) $ do
160 forM_ (map fst vals) $ \name ->
160 forM_ (map fst vals) $ \name ->
161 valueIsNotDefined moduleName name
161 valueIsNotDefined moduleName name
162− tys <- typesOf moduleName vals
162+ tys <- typesOf mainModuleName moduleName vals
163 vals' <- forM (zip (map fst vals) (map snd tys)) $ \(name, (val, ty)) -> do
163 vals' <- forM (zip (map fst vals) (map snd tys)) $ \(name, (val, ty)) -> do
164 addValue moduleName name ty
164 addValue moduleName name ty
165 return (name, val)
165 return (name, val)
166 return $ BindingGroupDeclaration vals'
166 return $ BindingGroupDeclaration vals'
167− ds <- typeCheckAll moduleName rest
167+ ds <- typeCheckAll mainModuleName moduleName rest
168 return $ d : ds
168 return $ d : ds
169−typeCheckAll moduleName (d@(ExternDataDeclaration name kind) : rest) = do
169+typeCheckAll mainModuleName moduleName (d@(ExternDataDeclaration name kind) : rest) = do
170 env <- getEnv
170 env <- getEnv
171 guardWith (show name ++ " is already defined") $ not $ M.member (moduleName, name) (types env)
171 guardWith (show name ++ " is already defined") $ not $ M.member (moduleName, name) (types env)
172 putEnv $ env { types = M.insert (moduleName, name) (kind, TypeSynonym) (types env) }
172 putEnv $ env { types = M.insert (moduleName, name) (kind, TypeSynonym) (types env) }
173− ds <- typeCheckAll moduleName rest
173+ ds <- typeCheckAll mainModuleName moduleName rest
174 return $ d : ds
174 return $ d : ds
175−typeCheckAll moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
175+typeCheckAll mainModuleName moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
176 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do
176 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do
177 env <- getEnv
177 env <- getEnv
178 kind <- kindOf moduleName ty
178 kind <- kindOf moduleName ty
@@ -180,14 +180,14 @@ typeCheckAll moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
180 case M.lookup (moduleName, name) (names env) of
180 case M.lookup (moduleName, name) (names env) of
181 Just _ -> throwError $ show name ++ " is already defined"
181 Just _ -> throwError $ show name ++ " is already defined"
182 Nothing -> putEnv (env { names = M.insert (moduleName, name) (qualifyAllUnqualifiedNames moduleName env ty, Extern importTy) (names env) })
182 Nothing -> putEnv (env { names = M.insert (moduleName, name) (qualifyAllUnqualifiedNames moduleName env ty, Extern importTy) (names env) })
183− ds <- typeCheckAll moduleName rest
183+ ds <- typeCheckAll mainModuleName moduleName rest
184 return $ d : ds
184 return $ d : ds
185−typeCheckAll moduleName (d@(FixityDeclaration _ name) : rest) = do
185+typeCheckAll mainModuleName moduleName (d@(FixityDeclaration _ name) : rest) = do
186− ds <- typeCheckAll moduleName rest
186+ ds <- typeCheckAll mainModuleName moduleName rest
187 env <- getEnv
187 env <- getEnv
188 guardWith ("Fixity declaration with no binding: " ++ name) $ M.member (moduleName, Op name) $ names env
188 guardWith ("Fixity declaration with no binding: " ++ name) $ M.member (moduleName, Op name) $ names env
189 return $ d : ds
189 return $ d : ds
190−typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
190+typeCheckAll mainModuleName currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
191 env <- getEnv
191 env <- getEnv
192 rethrow errorMessage $ do
192 rethrow errorMessage $ do
193 guardWith ("Module " ++ show moduleName ++ " does not exist") $ moduleExists env
193 guardWith ("Module " ++ show moduleName ++ " does not exist") $ moduleExists env
@@ -199,7 +199,7 @@ typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
199 shadowIdents (lefts idents') env
199 shadowIdents (lefts idents') env
200 shadowTypes (rights idents') env
200 shadowTypes (rights idents') env
201 shadowTypeClassInstances env
201 shadowTypeClassInstances env
202− ds <- typeCheckAll currentModule rest
202+ ds <- typeCheckAll mainModuleName currentModule rest
203 return $ d : ds
203 return $ d : ds
204 where
204 where
205 errorMessage = (("Error in import declaration " ++ show moduleName ++ ":\n") ++)
205 errorMessage = (("Error in import declaration " ++ show moduleName ++ ":\n") ++)
@@ -243,16 +243,16 @@ typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
243 constructs (TypeApp (TypeApp t _) ty) pn | t == tyFunction = ty `constructs` pn
243 constructs (TypeApp (TypeApp t _) ty) pn | t == tyFunction = ty `constructs` pn
244 constructs (TypeApp ty _) pn = ty `constructs` pn
244 constructs (TypeApp ty _) pn = ty `constructs` pn
245 constructs fn _ = error $ "Invalid arguments to constructs: " ++ show fn
245 constructs fn _ = error $ "Invalid arguments to constructs: " ++ show fn
246−typeCheckAll moduleName (d@(TypeClassDeclaration _ _ _) : rest) = do
246+typeCheckAll mainModuleName moduleName (d@(TypeClassDeclaration _ _ _) : rest) = do
247 env <- getEnv
247 env <- getEnv
248− ds <- typeCheckAll moduleName rest
248+ ds <- typeCheckAll mainModuleName moduleName rest
249 return $ qualifyAllUnqualifiedNames moduleName env d : ds
249 return $ qualifyAllUnqualifiedNames moduleName env d : ds
250−typeCheckAll moduleName (d@(TypeInstanceDeclaration deps className ty _) : rest) = do
250+typeCheckAll mainModuleName moduleName (d@(TypeInstanceDeclaration deps className ty _) : rest) = do
251 env <- getEnv
251 env <- getEnv
252 dictName <- Check . lift $ mkDictionaryValueName moduleName className ty
252 dictName <- Check . lift $ mkDictionaryValueName moduleName className ty
253 checkTypeClassInstance moduleName ty
253 checkTypeClassInstance moduleName ty
254 forM_ deps $ checkTypeClassInstance moduleName . snd
254 forM_ deps $ checkTypeClassInstance moduleName . snd
255 addTypeClassDictionaries (qualifyAllUnqualifiedNames moduleName env
255 addTypeClassDictionaries (qualifyAllUnqualifiedNames moduleName env
256 [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className ty (Just deps) TCDRegular])
256 [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className ty (Just deps) TCDRegular])
257− ds <- typeCheckAll moduleName rest
257+ ds <- typeCheckAll mainModuleName moduleName rest
258 return $ qualifyAllUnqualifiedNames moduleName env d : ds
258 return $ qualifyAllUnqualifiedNames moduleName env d : ds
src/Language/PureScript/TypeChecker/Types.hs+31−7
@@ -47,6 +47,7 @@ import qualified Data.Data as D
47import Data.Generics
47import Data.Generics
48 (everythingWithContext, mkM, everywhereM, everything, mkT,
48 (everythingWithContext, mkM, everywhereM, everything, mkT,
49 something, everywhere, mkQ)
49 something, everywhere, mkQ)
50+import Data.Generics.Extras
50
51
51import Language.PureScript.Values
52import Language.PureScript.Values
52import Language.PureScript.Types
53import Language.PureScript.Types
@@ -67,6 +68,7 @@ import Control.Arrow (Arrow(..))
67
68
68import qualified Data.Map as M
69import qualified Data.Map as M
69import Data.Function (on)
70import Data.Function (on)
71+import Data.Ord (comparing)
70
72
71instance Partial Type where
73instance Partial Type where
72 unknown = TUnknown
74 unknown = TUnknown
@@ -151,7 +153,7 @@ unifyRows r1 r2 =
151 unifyRows' [] REmpty [] REmpty = return ()
153 unifyRows' [] REmpty [] REmpty = return ()
152 unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()
154 unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()
153 unifyRows' [] (Skolem s1 _) [] (Skolem s2 _) | s1 == s2 = return ()
155 unifyRows' [] (Skolem s1 _) [] (Skolem s2 _) | s1 == s2 = return ()
154− unifyRows' sd3 r3 sd4 r4 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd3, r3)) ++ " with " ++ prettyPrintRow (rowFromList (sd4, r4)) ++ "."
156+ unifyRows' sd3 r3 sd4 r4 = throwError $ "Cannot unify (" ++ prettyPrintRow (rowFromList (sd3, r3)) ++ ") with (" ++ prettyPrintRow (rowFromList (sd4, r4)) ++ ")."
155
157
156-- |
158-- |
157-- Ensure type constructors are equal after canonicalization
159-- Ensure type constructors are equal after canonicalization
@@ -163,8 +165,8 @@ typeConstructorsAreEqual env moduleName = (==) `on` canonicalizeType moduleName
163-- Infer the types of multiple mutually-recursive values, and return elaborated values including
165-- Infer the types of multiple mutually-recursive values, and return elaborated values including
164-- type class dictionaries and type annotations.
166-- type class dictionaries and type annotations.
165--
167--
166−typesOf :: ModuleName -> [(Ident, Value)] -> Check [(Ident, (Value, Type))]
168+typesOf :: Maybe ModuleName -> ModuleName -> [(Ident, Value)] -> Check [(Ident, (Value, Type))]
167−typesOf moduleName vals = do
169+typesOf mainModuleName moduleName vals = do
168 tys <- fmap tidyUp . liftUnify $ do
170 tys <- fmap tidyUp . liftUnify $ do
169 let
171 let
170 -- Map each declaration to a name/value pair, with an optional type, if the declaration is typed
172 -- Map each declaration to a name/value pair, with an optional type, if the declaration is typed
@@ -203,8 +205,8 @@ typesOf moduleName vals = do
203 TypedValue _ val' ty <- bindNames dict' $ infer val
205 TypedValue _ val' ty <- bindNames dict' $ infer val
204 ty =?= fromMaybe (error "name not found in dictionary") (lookup ident untypedDict)
206 ty =?= fromMaybe (error "name not found in dictionary") (lookup ident untypedDict)
205 return (ident, (TypedValue True val' ty, ty))
207 return (ident, (TypedValue True val' ty, ty))
206− -- If run-main is enabled, need to check that Main.main has type Eff eff a for some eff, a
208+ -- If --main is enabled, need to check that `main` has type Eff eff a for some eff, a
207− when (moduleName == ModuleName (ProperName "Main") && fst e == Ident "main") $ do
209+ when (Just moduleName == mainModuleName && fst e == Ident "main") $ do
208 [eff, a] <- replicateM 2 fresh
210 [eff, a] <- replicateM 2 fresh
209 ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName (ProperName "Eff"))) (ProperName "Eff"))) eff) a
211 ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName (ProperName "Eff"))) (ProperName "Eff"))) eff) a
210 -- Make sure unification variables do not escape
212 -- Make sure unification variables do not escape
@@ -249,7 +251,7 @@ overTypes f = everywhere (mkT f)
249-- Replace type class dictionary placeholders with inferred type class dictionaries
251-- Replace type class dictionary placeholders with inferred type class dictionaries
250--
252--
251replaceTypeClassDictionaries :: ModuleName -> Value -> Check Value
253replaceTypeClassDictionaries :: ModuleName -> Value -> Check Value
252−replaceTypeClassDictionaries mn = everywhereM (mkM go)
254+replaceTypeClassDictionaries mn = everywhereM' (mkM go)
253 where
255 where
254 go (TypeClassDictionary constraint dicts) = entails mn dicts constraint
256 go (TypeClassDictionary constraint dicts) = entails mn dicts constraint
255 go other = return other
257 go other = return other
@@ -767,7 +769,8 @@ check' (TypedValue checkType val ty1) ty2 = do
767 Just moduleName <- checkCurrentModule <$> get
769 Just moduleName <- checkCurrentModule <$> get
768 kind <- liftCheck $ kindOf moduleName ty1
770 kind <- liftCheck $ kindOf moduleName ty1
769 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
771 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
772+ ty1' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1
770− val' <- subsumes (Just val) ty1 ty2
773+ val' <- subsumes (Just val) ty1' ty2
771 case val' of
774 case val' of
772 Nothing -> throwError "Unable to check type subsumption"
775 Nothing -> throwError "Unable to check type subsumption"
773 Just val'' -> do
776 Just val'' -> do
@@ -930,6 +933,27 @@ subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do
930 Just moduleName <- checkCurrentModule <$> get
933 Just moduleName <- checkCurrentModule <$> get
931 _ <- subsumes' Nothing ty1 ty2
934 _ <- subsumes' Nothing ty1 ty2
932 return . Just $ foldl App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))
935 return . Just $ foldl App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))
936+subsumes' val (Object r1) (Object r2) = do
937+ let
938+ (ts1, r1') = rowToList r1
939+ (ts2, r2') = rowToList r2
940+ ts1' = sortBy (comparing fst) ts1
941+ ts2' = sortBy (comparing fst) ts2
942+ go ts1' ts2' r1' r2'
943+ return val
944+ where
945+ go [] ts2 r1 r2 = r1 =?= rowFromList (ts2, r2)
946+ go ts1 [] r1 r2 = r2 =?= rowFromList (ts1, r1)
947+ go ((p1, ty1) : ts1) ((p2, ty2) : ts2) r1 r2
948+ | p1 == p2 = do subsumes Nothing ty1 ty2
949+ go ts1 ts2 r1 r2
950+ | p1 < p2 = do rest <- fresh
951+ r2 =?= RCons p1 ty1 rest
952+ go ts1 ((p2, ty2) : ts2) r1 rest
953+ | p1 > p2 = do rest <- fresh
954+ r1 =?= RCons p2 ty2 rest
955+ go ((p1, ty1) : ts1) ts2 rest r2
956+subsumes' val ty1 ty2@(Object _) = subsumes val ty2 ty1
933subsumes' val ty1 ty2 = do
957subsumes' val ty1 ty2 = do
934 ty1 =?= ty2
958 ty1 =?= ty2
935 return val
959 return val
tests/Main.hs+1−1
@@ -66,7 +66,7 @@ assertCompiles :: FilePath -> IO ()
66assertCompiles inputFile = do
66assertCompiles inputFile = do
67 putStrLn $ "assert " ++ inputFile ++ " compiles successfully"
67 putStrLn $ "assert " ++ inputFile ++ " compiles successfully"
68 prelude <- preludeFilename
68 prelude <- preludeFilename
69− assert (P.defaultOptions { P.optionsRunMain = True, P.optionsNoOptimizations = True, P.optionsEntryPoint = Just "Main" }) [prelude, inputFile] $ either (return . Just) $ \js -> do
69+ assert (P.defaultOptions { P.optionsMain = Just "Main", P.optionsNoOptimizations = True, P.optionsModules = ["Main"] }) [prelude, inputFile] $ either (return . Just) $ \js -> do
70 args <- getArgs
70 args <- getArgs
71 if "--run-js" `elem` args
71 if "--run-js" `elem` args
72 then do
72 then do