git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
swap
355eb9b2050 ahead, 0 behind
364 files changed+2712−24262
since splitsnapshots
unifiedsplit
.gitignore+10 .travis.yml−30 CONTRIBUTING.md−32 ChangeLog.md+3 LICENSE+24−1734 README-go.md+48 README.md+33−17 Setup.hs−4 app/Main.hs+250 bundle/.gitignore−3 bundle/README−20 bundle/build.sh−43 bundle/winbuild.sh−40 core-tests/.gitignore−2 core-tests/test-everything.sh−50 default.nix+23 examples/.gitignore−1 examples/failing/365.purs−11 examples/failing/438.purs−9 examples/failing/ArrayType.purs−11 examples/failing/Arrays.purs−5 examples/failing/Do.purs−8 examples/failing/DuplicateDeclarationsInLet.purs−9 examples/failing/DuplicateProperties1.purs−9 examples/failing/DuplicateProperties2.purs−9 examples/failing/DuplicateTypeVars.purs−3 examples/failing/Eff.purs−12 examples/failing/Foldable.purs−14 examples/failing/InstanceExport.purs−15 examples/failing/KindError.purs−3 examples/failing/Let.purs−3 examples/failing/MPTCs.purs−7 examples/failing/MissingClassExport.purs−4 examples/failing/MissingClassMemberExport.purs−4 examples/failing/MultipleErrors.purs−9 examples/failing/MultipleErrors2.purs−5 examples/failing/MutRec.purs−5 examples/failing/MutRec2.purs−3 examples/failing/NewtypeMultiArgs.purs−3 examples/failing/NewtypeMultiCtor.purs−3 examples/failing/NoOverlap.purs−11 examples/failing/NullaryAbs.purs−3 examples/failing/Object.purs−5 examples/failing/OverlappingArguments.purs−3 examples/failing/OverlappingBinders.purs−6 examples/failing/OverlappingInstances.purs−11 examples/failing/OverlappingInstances2.purs−23 examples/failing/OverlappingVars.purs−12 examples/failing/Rank2Types.purs−7 examples/failing/Reserved.purs−4 examples/failing/RowConstructors1.purs−6 examples/failing/RowConstructors2.purs−6 examples/failing/RowConstructors3.purs−6 examples/failing/SkolemEscape.purs−5 examples/failing/SkolemEscape2.purs−9 examples/failing/Superclasses1.purs−11 examples/failing/Superclasses2.purs−9 examples/failing/Superclasses3.purs−5 examples/failing/Superclasses4.purs−12 examples/failing/TopLevelCaseNoArgs.purs−4 examples/failing/TypeClassInstances.purs−8 examples/failing/TypeClasses2.purs−8 examples/failing/TypeError.purs−5 examples/failing/TypeSynonyms.purs−5 examples/failing/TypeSynonyms2.purs−9 examples/failing/TypeSynonyms3.purs−9 examples/failing/TypeSynonyms4.purs−8 examples/failing/TypeSynonyms5.purs−3 examples/failing/TypeWildcards1.purs−4 examples/failing/TypeWildcards2.purs−4 examples/failing/TypeWildcards3.purs−7 examples/failing/UnderscoreModuleName.purs−3 examples/failing/UnifyInTypeInstanceLookup.purs−17 examples/failing/UnknownType.purs−4 examples/manual/QualifiedNames.purs−11 examples/manual/failing/ArgLengthMismatch.purs−4 examples/manual/failing/ExportExplicit.purs−5 examples/manual/failing/ExportExplicit1.purs−14 examples/manual/failing/ExportExplicit2.purs−5 examples/manual/failing/ExportExplicit3.purs−13 examples/manual/failing/ImportExplicit.purs−7 examples/manual/failing/ImportExplicit2.purs−7 examples/manual/failing/ImportModule.purs−7 examples/manual/failing/OrphanTypeDecl.purs−3 examples/manual/failing/RedefinedFixity.purs−6 examples/manual/failing/RequiredHiddenType.purs−8 examples/manual/passing/ExportExplicit.purs−20 examples/manual/passing/ExportExplicit2.purs−15 examples/manual/passing/ExportedInstanceDeclarations.purs−41 examples/manual/passing/Import.purs−19 examples/manual/passing/ImportExplicit.purs−14 examples/manual/passing/ImportQualified.purs−12 examples/manual/passing/Module.purs−28 examples/manual/passing/ModuleDeps.purs−17 examples/manual/passing/RedefinedFixity.purs−24 examples/manual/passing/ShadowedName.purs−10 examples/manual/passing/TransitiveImport.purs−21 examples/manual/passing/WildcardType.purs−13 examples/passing/652.purs−15 examples/passing/810.purs−11 examples/passing/Applicative.purs−16 examples/passing/ArrayType.purs−9 examples/passing/Auto.purs−13 examples/passing/AutoPrelude.purs−8 examples/passing/AutoPrelude2.purs−9 examples/passing/BindersInFunctions.purs−18 examples/passing/BindingGroups.purs−8 examples/passing/BlockString.purs−12 examples/passing/CaseInDo.purs−20 examples/passing/CaseStatement.purs−19 examples/passing/CheckFunction.purs−5 examples/passing/CheckSynonymBug.purs−16 examples/passing/CheckTypeClass.purs−16 examples/passing/Church.purs−18 examples/passing/Collatz.purs−29 examples/passing/Comparisons.purs−25 examples/passing/Conditional.purs−9 examples/passing/Console.purs−13 examples/passing/DataAndType.purs−7 examples/passing/DeepArrayBinder.purs−20 examples/passing/DeepCase.purs−14 examples/passing/Do.purs−67 examples/passing/Dollar.purs−16 examples/passing/Eff.purs−25 examples/passing/EmptyDataDecls.purs−34 examples/passing/EmptyRow.purs−8 examples/passing/EmptyTypeClass.purs−12 examples/passing/EqOrd.purs−14 examples/passing/ExtendedInfixOperators.purs−12 examples/passing/ExternData.purs−13 examples/passing/ExternRaw.purs−26 examples/passing/FFI.purs−13 examples/passing/Fib.purs−15 examples/passing/FinalTagless.purs−22 examples/passing/ForeignInstance.purs−20 examples/passing/FunctionScope.purs−19 examples/passing/Functions.purs−15 examples/passing/Functions2.purs−19 examples/passing/Guards.purs−39 examples/passing/HoistError.purs−19 examples/passing/IfThenElseMaybe.purs−9 examples/passing/ImplicitEmptyImport.purs−6 examples/passing/ImportHiding.purs−18 examples/passing/InferRecFunWithConstrainedArgument.purs−8 examples/passing/InstanceBeforeClass.purs−9 examples/passing/IntAndChar.purs−25 examples/passing/JSReserved.purs−12 examples/passing/KindedType.purs−31 examples/passing/Let.purs−53 examples/passing/Let2.purs−15 examples/passing/LetInInstance.purs−12 examples/passing/LiberalTypeSynonyms.purs−19 examples/passing/MPTCs.purs−20 examples/passing/Match.purs−7 examples/passing/Monad.purs−32 examples/passing/MonadState.purs−48 examples/passing/MultiArgFunctions.purs−26 examples/passing/MutRec.purs−19 examples/passing/MutRec2.purs−17 examples/passing/MutRec3.purs−17 examples/passing/NamedPatterns.purs−7 examples/passing/NegativeBinder.purs−7 examples/passing/Nested.purs−7 examples/passing/NestedTypeSynonyms.purs−11 examples/passing/NestedWhere.purs−10 examples/passing/Newtype.purs−22 examples/passing/NewtypeEff.purs−28 examples/passing/NewtypeWithRecordUpdate.purs−15 examples/passing/ObjectGetter.purs−11 examples/passing/ObjectSynonym.purs−13 examples/passing/ObjectUpdate.purs−18 examples/passing/ObjectUpdate2.purs−14 examples/passing/ObjectUpdater.purs−35 examples/passing/ObjectWildcards.purs−31 examples/passing/Objects.purs−35 examples/passing/OneConstructor.purs−7 examples/passing/OperatorAssociativity.purs−50 examples/passing/OperatorInlining.purs−46 examples/passing/OperatorSections.purs−21 examples/passing/Operators.purs−98 examples/passing/OptimizerBug.purs−9 examples/passing/PartialFunction.purs−19 examples/passing/Patterns.purs−22 examples/passing/Person.purs−18 examples/passing/Rank2Data.purs−29 examples/passing/Rank2Object.purs−10 examples/passing/Rank2TypeSynonym.purs−15 examples/passing/Rank2Types.purs−11 examples/passing/RebindableSyntax.purs−37 examples/passing/Recursion.purs−10 examples/passing/ReservedWords.purs−13 examples/passing/RowConstructors.purs−40 examples/passing/RowPolyInstanceContext.purs−20 examples/passing/RowSynonyms.purs−46 examples/passing/RuntimeScopeIssue.purs−19 examples/passing/ScopedTypeVariables.purs−34 examples/passing/Sequence.purs−14 examples/passing/SequenceDesugared.purs−36 examples/passing/ShadowedRename.purs−21 examples/passing/ShadowedTCO.purs−16 examples/passing/ShadowedTCOLet.purs−7 examples/passing/SignedNumericLiterals.purs−15 examples/passing/Superclasses1.purs−18 examples/passing/Superclasses2.purs−23 examples/passing/Superclasses3.purs−41 examples/passing/TCOCase.purs−10 examples/passing/TailCall.purs−17 examples/passing/Tick.purs−5 examples/passing/TopLevelCase.purs−28 examples/passing/TypeClassImport.purs−18 examples/passing/TypeClassMemberOrderChange.purs−11 examples/passing/TypeClasses.purs−69 examples/passing/TypeClassesInOrder.purs−11 examples/passing/TypeClassesWithOverlappingTypeVariables.purs−11 examples/passing/TypeDecl.purs−12 examples/passing/TypeSynonymInData.purs−9 examples/passing/TypeSynonyms.purs−25 examples/passing/TypeWildcards.purs−13 examples/passing/TypeWildcardsRecordExtension.purs−6 examples/passing/TypedWhere.purs−15 examples/passing/UnderscoreIdent.purs−9 examples/passing/Unit.purs−6 examples/passing/UnknownInTypeClassLookup.purs−12 examples/passing/Where.purs−49 examples/passing/iota.purs−9 examples/passing/s.purs−5 hierarchy/Main.hs−110 license-generator/generate−44 license-generator/header.txt−23 license-generator/tmp/.gitkeep logo.png package.yaml+86 psc-docs/Ctags.hs−13 psc-docs/Etags.hs−15 psc-docs/Main.hs−249 psc-docs/Tags.hs−18 psc-make/Main.hs−171 psc-make/Make.hs−136 psc-publish/BoxesHelpers.hs−38 psc-publish/ErrorsWarnings.hs−317 psc-publish/Main.hs−280 psc-publish/Utils.hs−22 psc-publish/tests/Test.hs−76 psc/Main.hs−281 psci/Completion.hs−223 psci/Directive.hs−113 psci/IO.hs−21 psci/Make.hs−127 psci/PSCi.hs−560 psci/Parser.hs−139 psci/Types.hs−170 psci/main/Main.hs−6 psci/tests/Main.hs−141 psci/tests/data/Sample.purs psgo.cabal+145 purescript.cabal−237 src/CodeGen/IL.hs+321 src/CodeGen/IL/Common.hs+196 src/CodeGen/IL/Optimizer.hs+81 src/CodeGen/IL/Optimizer/Common.hs+18 src/CodeGen/IL/Optimizer/Inliner.hs+435 src/CodeGen/IL/Optimizer/MagicDo.hs+146 src/CodeGen/IL/Optimizer/TCO.hs+141 src/CodeGen/IL/Printer.hs+527 src/Control/Monad/Supply.hs−43 src/Control/Monad/Supply/Class.hs−36 src/Control/Monad/Unify.hs−159 src/Language/PureScript.hs−262 src/Language/PureScript/AST.hs−24 src/Language/PureScript/AST/Binders.hs−86 src/Language/PureScript/AST/Declarations.hs−410 src/Language/PureScript/AST/Exported.hs−132 src/Language/PureScript/AST/Operators.hs−39 src/Language/PureScript/AST/SourcePos.hs−71 src/Language/PureScript/AST/Traversals.hs−401 src/Language/PureScript/CodeGen.hs−25 src/Language/PureScript/CodeGen/Externs.hs−121 src/Language/PureScript/CodeGen/JS.hs−369 src/Language/PureScript/CodeGen/JS/AST.hs−343 src/Language/PureScript/CodeGen/JS/Common.hs−181 src/Language/PureScript/CodeGen/JS/Optimizer.hs−89 src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs−42 src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs−77 src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs−319 src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs−165 src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs−128 src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs−46 src/Language/PureScript/Comments.hs−25 src/Language/PureScript/Constants.hs−281 src/Language/PureScript/CoreFn.hs−26 src/Language/PureScript/CoreFn/Ann.hs−37 src/Language/PureScript/CoreFn/Binders.hs−48 src/Language/PureScript/CoreFn/Desugar.hs−264 src/Language/PureScript/CoreFn/Expr.hs−134 src/Language/PureScript/CoreFn/Literals.hs−50 src/Language/PureScript/CoreFn/Meta.hs−55 src/Language/PureScript/CoreFn/Module.hs−31 src/Language/PureScript/CoreFn/Traversals.hs−85 src/Language/PureScript/DeadCodeElimination.hs−102 src/Language/PureScript/Docs.hs−13 src/Language/PureScript/Docs/AsMarkdown.hs−102 src/Language/PureScript/Docs/ParseAndDesugar.hs−123 src/Language/PureScript/Docs/Render.hs−239 src/Language/PureScript/Docs/RenderedCode.hs−11 src/Language/PureScript/Docs/RenderedCode/Render.hs−165 src/Language/PureScript/Docs/RenderedCode/Types.hs−191 src/Language/PureScript/Docs/Types.hs−335 src/Language/PureScript/Docs/Utils/MonoidExtras.hs−9 src/Language/PureScript/Environment.hs−247 src/Language/PureScript/Errors.hs−793 src/Language/PureScript/Kinds.hs−68 src/Language/PureScript/Linter.hs−73 src/Language/PureScript/ModuleDependencies.hs−77 src/Language/PureScript/Names.hs−85 src/Language/PureScript/Options.hs−92 src/Language/PureScript/Parser.hs−36 src/Language/PureScript/Parser/Common.hs−139 src/Language/PureScript/Parser/Declarations.hs−543 src/Language/PureScript/Parser/JS.hs−59 src/Language/PureScript/Parser/Kinds.hs−45 src/Language/PureScript/Parser/Lexer.hs−512 src/Language/PureScript/Parser/State.hs−30 src/Language/PureScript/Parser/Types.hs−137 src/Language/PureScript/Pretty.hs−32 src/Language/PureScript/Pretty/Common.hs−69 src/Language/PureScript/Pretty/JS.hs−301 src/Language/PureScript/Pretty/Kinds.hs−59 src/Language/PureScript/Pretty/Types.hs−127 src/Language/PureScript/Pretty/Values.hs−242 src/Language/PureScript/Renamer.hs−196 src/Language/PureScript/Sugar.hs−71 src/Language/PureScript/Sugar/BindingGroups.hs−206 src/Language/PureScript/Sugar/CaseDeclarations.hs−180 src/Language/PureScript/Sugar/DoNotation.hs−74 src/Language/PureScript/Sugar/Names.hs−542 src/Language/PureScript/Sugar/ObjectWildcards.hs−65 src/Language/PureScript/Sugar/Operators.hs−166 src/Language/PureScript/Sugar/TypeClasses.hs−297 src/Language/PureScript/Sugar/TypeDeclarations.hs−69 src/Language/PureScript/Traversals.hs−41 src/Language/PureScript/TypeChecker.hs−347 src/Language/PureScript/TypeChecker/Entailment.hs−212 src/Language/PureScript/TypeChecker/Kinds.hs−218 src/Language/PureScript/TypeChecker/Monad.hs−266 src/Language/PureScript/TypeChecker/Rows.hs−67 src/Language/PureScript/TypeChecker/Skolems.hs−114 src/Language/PureScript/TypeChecker/Subsumption.hs−96 src/Language/PureScript/TypeChecker/Synonyms.hs−112 src/Language/PureScript/TypeChecker/Types.hs−675 src/Language/PureScript/TypeChecker/Unify.hs−206 src/Language/PureScript/TypeClassDictionaries.hs−96 src/Language/PureScript/Types.hs−305 src/Tests.hs+141 stack.nix+23 stack.yaml+24 support/ffi-loader.go+30 support/go.mod.ffi-loader+2 support/go.mod.output+2 support/go.mod.working+1 test/Spec.hs+2 tests/Main.hs−109 tests/prelude.purs−1068 travis-after-script.sh−21 travis-script.sh−17
.gitignore+10
@@ -9,5 +9,15 @@ cabal.sandbox.config
99*.lksh*
1010.virthualenv
1111.psci_modules/
12+.test_modules/
1213bower_components/
14+node_modules
1315tmp/
16+.stack-work/
17+stack.yaml.lock
18+output
19+examples/docs/docs/
20+core-tests/full-core-docs.md
21+.psc-ide-port
22+.vscode/
23+result
.travis.ymldeleted−30
@@ -1,30 +0,0 @@
1−env:
2− - CABALVER=1.22 GHCVER=7.8.3 SUITE=tests
3− - CABALVER=1.22 GHCVER=7.8.3 SUITE=psci-tests
4−before_install:
5− - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
6− - travis_retry sudo apt-get update
7− - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
8− - export PATH="/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.cabal/bin:$PATH"
9−install:
10− - cabal --version
11− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
12− - travis_retry cabal update
13− - cabal install --only-dependencies --enable-tests --enable-benchmarks
14−script:
15− - ./travis-script.sh
16−after_script:
17− - ./travis-after-script.sh
18−notifications:
19− email: true
20−before_deploy: "./bundle/build.sh linux64"
21−deploy:
22− provider: releases
23− api_key: $RELEASE_KEY
24− file:
25− - bundle/linux64.tar.gz
26− - bundle/linux64.sha
27− skip_cleanup: true
28− on:
29− all_branches: true
30− tags: true
CONTRIBUTING.mddeleted−32
@@ -1,32 +0,0 @@
1−An introductory overview of the compiler is available [here](https://www.youtube.com/watch?v=Y3P1dxqwFiE).
2−
3−Pull requests are encouraged.
4−
5−Please follow the following guidelines:
6−
7−- Add at least a test to `examples/passing/` and possibly to `examples/failing`.
8−- Build the binaries and libs with `cabal build`
9−- Install the binaries and libs with `cabal install`.
10−- Run `cabal configure --enable-tests && cabal build && cabal test` to build the test suite.
11−- Run `purescript-test-everything` to make sure you haven't broken any core library builds.
12−- Run `starter-kit` to make sure the starter kit has not been broken.
13−
14−If you would like to contribute, please consider the issues in the current milestone first. If you are a new contributor, you may want to have a go at the ["easy" issues](https://github.com/purescript/purescript/labels/easy) to get started.
15−
16−Finally, if you have made code changes and would like to be included in the copyright notice in the cabal file, please include that change in your pull request.
17−
18−To prevent core libraries from getting broken, every change must be reviewed. A pull request will be merged as long as one other team member has verified the changes.
19−
20−## Adding dependencies
21−
22−Because the PureScript compiler is distributed in binary form, we include
23−the licenses of all dependencies, including transitive ones, in the LICENSE
24−file. Therefore, whenever the dependencies change, the LICENSE file should be
25−updated.
26−
27−You can automate this (if you have bash):
28−
29−- get a copy of [cabal-dependency-licenses][]
30−- run at the command line: `./license/generate > LICENSE`
31−
32−[cabal-dependency-licenses]: https://github.com/jaspervdj/cabal-dependency-licenses
ChangeLog.mdnew file+3
@@ -0,0 +1,3 @@
1+# Changelog for pscpp
2+
3+## Unreleased changes
LICENSE+24−1734
@@ -1,1740 +1,30 @@
1−The MIT License (MIT)
1+Copyright Andy Arvanitis (c) 2018
22
3−Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other
4−contributors
3+All rights reserved.
54
6−Permission is hereby granted, free of charge, to any person obtaining a copy of
7−this software and associated documentation files (the "Software"), to deal in
8−the Software without restriction, including without limitation the rights to
9−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
10−the Software, and to permit persons to whom the Software is furnished to do so,
11−subject to the following conditions:
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
127
13−The above copyright notice and this permission notice shall be included in all
14−copies or substantial portions of the Software.
15−
16−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
18−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
19−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
20−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
21−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22−
23−PureScript uses the following Haskell library packages. Their license files follow.
24−
25− aeson
26− aeson-better-errors
27− ansi-terminal
28− ansi-wl-pprint
29− array
30− attoparsec
31− base
32− bower-json
33− boxes
34− bytestring
35− containers
36− deepseq
37− directory
38− dlist
39− filepath
40− ghc-prim
41− Glob
42− hashable
43− haskeline
44− integer-gmp
45− mtl
46− nats
47− old-locale
48− optparse-applicative
49− parsec
50− pattern-arrows
51− pretty
52− primitive
53− process
54− rts
55− safe
56− scientific
57− semigroups
58− split
59− syb
60− template-haskell
61− terminfo
62− text
63− time
64− transformers
65− transformers-compat
66− unix
67− unordered-containers
68− utf8-string
69− vector
70− void
71−
72−aeson LICENSE file:
73−
74− Copyright (c) 2011, MailRank, Inc.
75−
76− All rights reserved.
77−
78− Redistribution and use in source and binary forms, with or without
79− modification, are permitted provided that the following conditions
80− are met:
81−
82− 1. Redistributions of source code must retain the above copyright
83− notice, this list of conditions and the following disclaimer.
84−
85− 2. Redistributions in binary form must reproduce the above copyright
86− notice, this list of conditions and the following disclaimer in the
87− documentation and/or other materials provided with the distribution.
88−
89− 3. Neither the name of the author nor the names of his contributors
90− may be used to endorse or promote products derived from this software
91− without specific prior written permission.
92−
93− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
94− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
95− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
96− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
97− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
98− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
99− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
100− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
101− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
102− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
103− POSSIBILITY OF SUCH DAMAGE.
104−
105−aeson-better-errors LICENSE file:
106−
107− Copyright (c) 2015 Harry Garrood
108−
109− Permission is hereby granted, free of charge, to any person obtaining
110− a copy of this software and associated documentation files (the
111− "Software"), to deal in the Software without restriction, including
112− without limitation the rights to use, copy, modify, merge, publish,
113− distribute, sublicense, and/or sell copies of the Software, and to
114− permit persons to whom the Software is furnished to do so, subject to
115− the following conditions:
116−
117− The above copyright notice and this permission notice shall be included
118− in all copies or substantial portions of the Software.
119−
120− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
121− EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
122− MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
123− IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
124− CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
125− TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
126− SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
127−
128−ansi-terminal LICENSE file:
129−
130− Copyright (c) 2008, Maximilian Bolingbroke
131− All rights reserved.
132−
133− Redistribution and use in source and binary forms, with or without modification, are permitted
134− provided that the following conditions are met:
135−
136− * Redistributions of source code must retain the above copyright notice, this list of
137− conditions and the following disclaimer.
138− * Redistributions in binary form must reproduce the above copyright notice, this list of
139− conditions and the following disclaimer in the documentation and/or other materials
140− provided with the distribution.
141− * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to
142− endorse or promote products derived from this software without specific prior written permission.
143−
144− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
145− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
146− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
147− CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
148− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
149− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
150− IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
151− OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
152−ansi-wl-pprint LICENSE file:
153−
154− Copyright 2008, Daan Leijen and Max Bolingbroke. All rights reserved.
155−
156− Redistribution and use in source and binary forms, with or without
157− modification, are permitted provided that the following conditions are
158− met:
159−
1608 * Redistributions of source code must retain the above copyright
1619 notice, this list of conditions and the following disclaimer.
162−
163− * Redistributions in binary form must reproduce the above copyright
164− notice, this list of conditions and the following disclaimer in
165− the documentation and/or other materials provided with the
166− distribution.
167−
168− This software is provided by the copyright holders "as is" and any
169− express or implied warranties, including, but not limited to, the
170− implied warranties of merchantability and fitness for a particular
171− purpose are disclaimed. In no event shall the copyright holders be
172− liable for any direct, indirect, incidental, special, exemplary, or
173− consequential damages (including, but not limited to, procurement of
174− substitute goods or services; loss of use, data, or profits; or
175− business interruption) however caused and on any theory of liability,
176− whether in contract, strict liability, or tort (including negligence
177− or otherwise) arising in any way out of the use of this software, even
178− if advised of the possibility of such damage.
179−
180−array LICENSE file:
181−
182− This library (libraries/base) is derived from code from several
183− sources:
184−
185− * Code from the GHC project which is largely (c) The University of
186− Glasgow, and distributable under a BSD-style license (see below),
187−
188− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
189− and freely redistributable (but see the full license for
190− restrictions).
191−
192− * Code from the Haskell Foreign Function Interface specification,
193− which is (c) Manuel M. T. Chakravarty and freely redistributable
194− (but see the full license for restrictions).
195−
196− The full text of these licenses is reproduced below. All of the
197− licenses are BSD-style or compatible.
198−
199− -----------------------------------------------------------------------------
200−
201− The Glasgow Haskell Compiler License
202−
203− Copyright 2004, The University Court of the University of Glasgow.
204− All rights reserved.
205−
206− Redistribution and use in source and binary forms, with or without
207− modification, are permitted provided that the following conditions are met:
208−
209− - Redistributions of source code must retain the above copyright notice,
210− this list of conditions and the following disclaimer.
211−
212− - Redistributions in binary form must reproduce the above copyright notice,
213− this list of conditions and the following disclaimer in the documentation
214− and/or other materials provided with the distribution.
215−
216− - Neither name of the University nor the names of its contributors may be
217− used to endorse or promote products derived from this software without
218− specific prior written permission.
219−
220− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
221− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
222− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
223− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
224− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
225− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
226− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
227− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
228− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
229− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
230− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
231− DAMAGE.
232−
233− -----------------------------------------------------------------------------
234−
235− Code derived from the document "Report on the Programming Language
236− Haskell 98", is distributed under the following license:
237−
238− Copyright (c) 2002 Simon Peyton Jones
239−
240− The authors intend this Report to belong to the entire Haskell
241− community, and so we grant permission to copy and distribute it for
242− any purpose, provided that it is reproduced in its entirety,
243− including this Notice. Modified versions of this Report may also be
244− copied and distributed for any purpose, provided that the modified
245− version is clearly presented as such, and that it does not claim to
246− be a definition of the Haskell 98 Language.
247−
248− -----------------------------------------------------------------------------
249−
250− Code derived from the document "The Haskell 98 Foreign Function
251− Interface, An Addendum to the Haskell 98 Report" is distributed under
252− the following license:
253−
254− Copyright (c) 2002 Manuel M. T. Chakravarty
255−
256− The authors intend this Report to belong to the entire Haskell
257− community, and so we grant permission to copy and distribute it for
258− any purpose, provided that it is reproduced in its entirety,
259− including this Notice. Modified versions of this Report may also be
260− copied and distributed for any purpose, provided that the modified
261− version is clearly presented as such, and that it does not claim to
262− be a definition of the Haskell 98 Foreign Function Interface.
263−
264− -----------------------------------------------------------------------------
265−
266−attoparsec LICENSE file:
267−
268− Copyright (c) Lennart Kolmodin
269−
270− All rights reserved.
271−
272− Redistribution and use in source and binary forms, with or without
273− modification, are permitted provided that the following conditions
274− are met:
275−
276− 1. Redistributions of source code must retain the above copyright
277− notice, this list of conditions and the following disclaimer.
278−
279− 2. Redistributions in binary form must reproduce the above copyright
280− notice, this list of conditions and the following disclaimer in the
281− documentation and/or other materials provided with the distribution.
282−
283− 3. Neither the name of the author nor the names of his contributors
284− may be used to endorse or promote products derived from this software
285− without specific prior written permission.
286−
287− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
288− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
289− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
290− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
291− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
292− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
293− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
294− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
295− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
296− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
297− POSSIBILITY OF SUCH DAMAGE.
298−
299−base LICENSE file:
300−
301− This library (libraries/base) is derived from code from several
302− sources:
303−
304− * Code from the GHC project which is largely (c) The University of
305− Glasgow, and distributable under a BSD-style license (see below),
306−
307− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
308− and freely redistributable (but see the full license for
309− restrictions).
310−
311− * Code from the Haskell Foreign Function Interface specification,
312− which is (c) Manuel M. T. Chakravarty and freely redistributable
313− (but see the full license for restrictions).
314−
315− The full text of these licenses is reproduced below. All of the
316− licenses are BSD-style or compatible.
317−
318− -----------------------------------------------------------------------------
319−
320− The Glasgow Haskell Compiler License
321−
322− Copyright 2004, The University Court of the University of Glasgow.
323− All rights reserved.
324−
325− Redistribution and use in source and binary forms, with or without
326− modification, are permitted provided that the following conditions are met:
327−
328− - Redistributions of source code must retain the above copyright notice,
329− this list of conditions and the following disclaimer.
330−
331− - Redistributions in binary form must reproduce the above copyright notice,
332− this list of conditions and the following disclaimer in the documentation
333− and/or other materials provided with the distribution.
334−
335− - Neither name of the University nor the names of its contributors may be
336− used to endorse or promote products derived from this software without
337− specific prior written permission.
338−
339− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
340− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
341− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
342− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
343− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
344− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
345− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
346− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
347− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
348− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
349− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
350− DAMAGE.
351−
352− -----------------------------------------------------------------------------
353−
354− Code derived from the document "Report on the Programming Language
355− Haskell 98", is distributed under the following license:
356−
357− Copyright (c) 2002 Simon Peyton Jones
358−
359− The authors intend this Report to belong to the entire Haskell
360− community, and so we grant permission to copy and distribute it for
361− any purpose, provided that it is reproduced in its entirety,
362− including this Notice. Modified versions of this Report may also be
363− copied and distributed for any purpose, provided that the modified
364− version is clearly presented as such, and that it does not claim to
365− be a definition of the Haskell 98 Language.
366−
367− -----------------------------------------------------------------------------
368−
369− Code derived from the document "The Haskell 98 Foreign Function
370− Interface, An Addendum to the Haskell 98 Report" is distributed under
371− the following license:
372−
373− Copyright (c) 2002 Manuel M. T. Chakravarty
374−
375− The authors intend this Report to belong to the entire Haskell
376− community, and so we grant permission to copy and distribute it for
377− any purpose, provided that it is reproduced in its entirety,
378− including this Notice. Modified versions of this Report may also be
379− copied and distributed for any purpose, provided that the modified
380− version is clearly presented as such, and that it does not claim to
381− be a definition of the Haskell 98 Foreign Function Interface.
382−
383− -----------------------------------------------------------------------------
384−
385−bower-json LICENSE file:
386−
387− Copyright (c) 2015 Harry Garrood
388−
389− Permission is hereby granted, free of charge, to any person obtaining
390− a copy of this software and associated documentation files (the
391− "Software"), to deal in the Software without restriction, including
392− without limitation the rights to use, copy, modify, merge, publish,
393− distribute, sublicense, and/or sell copies of the Software, and to
394− permit persons to whom the Software is furnished to do so, subject to
395− the following conditions:
396−
397− The above copyright notice and this permission notice shall be included
398− in all copies or substantial portions of the Software.
399−
400− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
401− EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
402− MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
403− IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
404− CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
405− TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
406− SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
407−
408−boxes LICENSE file:
409−
410− Copyright (c) Brent Yorgey 2008
411−
412− Redistribution and use in source and binary forms, with or without
413− modification, are permitted provided that the following conditions
414− are met:
415− 1. Redistributions of source code must retain the above copyright
416− notice, this list of conditions and the following disclaimer.
417− 2. Redistributions in binary form must reproduce the above copyright
418− notice, this list of conditions and the following disclaimer in the
419− documentation and/or other materials provided with the distribution.
420− 3. Neither the name of the author nor the names of other contributors
421− may be used to endorse or promote products derived from this software
422− without specific prior written permission.
423−
424− All other rights are reserved.
425−
426− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
427− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
428− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
429− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
430− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
431− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
432− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
433− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
434− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
435− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
436− SUCH DAMAGE.
437−
438−bytestring LICENSE file:
439−
440− Copyright (c) Don Stewart 2005-2009
441− (c) Duncan Coutts 2006-2015
442− (c) David Roundy 2003-2005
443− (c) Simon Meier 2010-2011
444−
445− All rights reserved.
446−
447− Redistribution and use in source and binary forms, with or without
448− modification, are permitted provided that the following conditions
449− are met:
450− 1. Redistributions of source code must retain the above copyright
451− notice, this list of conditions and the following disclaimer.
452− 2. Redistributions in binary form must reproduce the above copyright
453− notice, this list of conditions and the following disclaimer in the
454− documentation and/or other materials provided with the distribution.
455− 3. Neither the name of the author nor the names of his contributors
456− may be used to endorse or promote products derived from this software
457− without specific prior written permission.
458−
459− THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
460− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
461− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
462− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
463− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
464− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
465− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
466− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
467− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
468− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
469− SUCH DAMAGE.
470−
471−containers LICENSE file:
472−
473− The Glasgow Haskell Compiler License
474−
475− Copyright 2004, The University Court of the University of Glasgow.
476− All rights reserved.
477−
478− Redistribution and use in source and binary forms, with or without
479− modification, are permitted provided that the following conditions are met:
480−
481− - Redistributions of source code must retain the above copyright notice,
482− this list of conditions and the following disclaimer.
483−
484− - Redistributions in binary form must reproduce the above copyright notice,
485− this list of conditions and the following disclaimer in the documentation
486− and/or other materials provided with the distribution.
487−
488− - Neither name of the University nor the names of its contributors may be
489− used to endorse or promote products derived from this software without
490− specific prior written permission.
491−
492− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
493− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
494− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
495− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
496− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
497− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
498− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
499− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
500− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
501− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
502− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
503− DAMAGE.
504−
505−deepseq LICENSE file:
506−
507− This library (deepseq) is derived from code from the GHC project which
508− is largely (c) The University of Glasgow, and distributable under a
509− BSD-style license (see below).
510−
511− -----------------------------------------------------------------------------
512−
513− The Glasgow Haskell Compiler License
514−
515− Copyright 2001-2009, The University Court of the University of Glasgow.
516− All rights reserved.
517−
518− Redistribution and use in source and binary forms, with or without
519− modification, are permitted provided that the following conditions are met:
520−
521− - Redistributions of source code must retain the above copyright notice,
522− this list of conditions and the following disclaimer.
523−
524− - Redistributions in binary form must reproduce the above copyright notice,
525− this list of conditions and the following disclaimer in the documentation
526− and/or other materials provided with the distribution.
527−
528− - Neither name of the University nor the names of its contributors may be
529− used to endorse or promote products derived from this software without
530− specific prior written permission.
531−
532− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
533− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
534− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
535− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
536− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
537− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
538− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
539− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
540− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
541− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
542− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
543− DAMAGE.
544−
545− -----------------------------------------------------------------------------
546−
547−directory LICENSE file:
548−
549− This library (libraries/base) is derived from code from two
550− sources:
551−
552− * Code from the GHC project which is largely (c) The University of
553− Glasgow, and distributable under a BSD-style license (see below),
554−
555− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
556− and freely redistributable (but see the full license for
557− restrictions).
558−
559− The full text of these licenses is reproduced below. Both of the
560− licenses are BSD-style or compatible.
561−
562− -----------------------------------------------------------------------------
563−
564− The Glasgow Haskell Compiler License
565−
566− Copyright 2004, The University Court of the University of Glasgow.
567− All rights reserved.
568−
569− Redistribution and use in source and binary forms, with or without
570− modification, are permitted provided that the following conditions are met:
571−
572− - Redistributions of source code must retain the above copyright notice,
573− this list of conditions and the following disclaimer.
574−
575− - Redistributions in binary form must reproduce the above copyright notice,
576− this list of conditions and the following disclaimer in the documentation
577− and/or other materials provided with the distribution.
578−
579− - Neither name of the University nor the names of its contributors may be
580− used to endorse or promote products derived from this software without
581− specific prior written permission.
582−
583− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
584− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
585− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
586− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
587− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
588− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
589− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
590− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
591− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
592− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
593− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
594− DAMAGE.
595−
596− -----------------------------------------------------------------------------
597−
598− Code derived from the document "Report on the Programming Language
599− Haskell 98", is distributed under the following license:
600−
601− Copyright (c) 2002 Simon Peyton Jones
602−
603− The authors intend this Report to belong to the entire Haskell
604− community, and so we grant permission to copy and distribute it for
605− any purpose, provided that it is reproduced in its entirety,
606− including this Notice. Modified versions of this Report may also be
607− copied and distributed for any purpose, provided that the modified
608− version is clearly presented as such, and that it does not claim to
609− be a definition of the Haskell 98 Language.
610−
611− -----------------------------------------------------------------------------
612−
613−dlist LICENSE file:
614−
615− Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather
616−
617− All rights reserved.
618−
619− Redistribution and use in source and binary forms, with or without
620− modification, are permitted provided that the following conditions are
621− met:
622−
623− * Redistributions of source code must retain the above copyright
624− notice, this list of conditions and the following disclaimer.
625−
626− * Redistributions in binary form must reproduce the above
627− copyright notice, this list of conditions and the following
628− disclaimer in the documentation and/or other materials provided
629− with the distribution.
630−
631− * Neither the name of Don Stewart nor the names of other
632− contributors may be used to endorse or promote products derived
633− from this software without specific prior written permission.
634−
635− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
636− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
637− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
638− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
639− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
640− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
641− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
642− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
643− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
644− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
645− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
646−
647−filepath LICENSE file:
648−
649− Copyright Neil Mitchell 2005-2015.
650− All rights reserved.
651−
652− Redistribution and use in source and binary forms, with or without
653− modification, are permitted provided that the following conditions are
654− met:
655−
656− * Redistributions of source code must retain the above copyright
657− notice, this list of conditions and the following disclaimer.
658−
659− * Redistributions in binary form must reproduce the above
660− copyright notice, this list of conditions and the following
661− disclaimer in the documentation and/or other materials provided
662− with the distribution.
663−
664− * Neither the name of Neil Mitchell nor the names of other
665− contributors may be used to endorse or promote products derived
666− from this software without specific prior written permission.
667−
668− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
669− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
670− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
671− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
672− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
673− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
674− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
675− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
676− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
677− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
678− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
679−
680−ghc-prim LICENSE file:
681−
682− This library (libraries/ghc-prim) is derived from code from several
683− sources:
684−
685− * Code from the GHC project which is largely (c) The University of
686− Glasgow, and distributable under a BSD-style license (see below),
687−
688− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
689− and freely redistributable (but see the full license for
690− restrictions).
691−
692− The full text of these licenses is reproduced below. All of the
693− licenses are BSD-style or compatible.
694−
695− -----------------------------------------------------------------------------
696−
697− The Glasgow Haskell Compiler License
698−
699− Copyright 2004, The University Court of the University of Glasgow.
700− All rights reserved.
701−
702− Redistribution and use in source and binary forms, with or without
703− modification, are permitted provided that the following conditions are met:
704−
705− - Redistributions of source code must retain the above copyright notice,
706− this list of conditions and the following disclaimer.
707−
708− - Redistributions in binary form must reproduce the above copyright notice,
709− this list of conditions and the following disclaimer in the documentation
710− and/or other materials provided with the distribution.
711−
712− - Neither name of the University nor the names of its contributors may be
713− used to endorse or promote products derived from this software without
714− specific prior written permission.
715−
716− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
717− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
718− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
719− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
720− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
721− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
722− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
723− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
724− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
725− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
726− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
727− DAMAGE.
728−
729− -----------------------------------------------------------------------------
730−
731− Code derived from the document "Report on the Programming Language
732− Haskell 98", is distributed under the following license:
733−
734− Copyright (c) 2002 Simon Peyton Jones
735−
736− The authors intend this Report to belong to the entire Haskell
737− community, and so we grant permission to copy and distribute it for
738− any purpose, provided that it is reproduced in its entirety,
739− including this Notice. Modified versions of this Report may also be
740− copied and distributed for any purpose, provided that the modified
741− version is clearly presented as such, and that it does not claim to
742− be a definition of the Haskell 98 Language.
743−
744−
745−Glob LICENSE file:
746−
747− Page not found: Sorry, it's just not here.
748−
749−hashable LICENSE file:
750−
751− Copyright Milan Straka 2010
752−
753− All rights reserved.
754−
755− Redistribution and use in source and binary forms, with or without
756− modification, are permitted provided that the following conditions are met:
757−
758− * Redistributions of source code must retain the above copyright
759− notice, this list of conditions and the following disclaimer.
760−
761− * Redistributions in binary form must reproduce the above
762− copyright notice, this list of conditions and the following
763− disclaimer in the documentation and/or other materials provided
764− with the distribution.
765−
766− * Neither the name of Milan Straka nor the names of other
767− contributors may be used to endorse or promote products derived
768− from this software without specific prior written permission.
769−
770− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
771− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
772− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
773− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
774− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
775− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
776− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
777− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
778− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
779− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
780− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
781−
782−haskeline LICENSE file:
783−
784− Copyright 2007-2009, Judah Jacobson.
785− All Rights Reserved.
786−
787− Redistribution and use in source and binary forms, with or without
788− modification, are permitted provided that the following conditions are met:
789−
790− - Redistribution of source code must retain the above copyright notice,
791− this list of conditions and the following disclaimer.
792−
793− - Redistribution in binary form must reproduce the above copyright notice,
794− this list of conditions and the following disclaimer in the documentation
795− and/or other materials provided with the distribution.
796−
797− THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
798− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
799− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
800− DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
801− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
802− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
803− SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
804− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
805− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
806− USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
807−
808−integer-gmp LICENSE file:
809−
810− Copyright (c) 2014, Herbert Valerio Riedel
811−
812− All rights reserved.
813−
814− Redistribution and use in source and binary forms, with or without
815− modification, are permitted provided that the following conditions are met:
816−
817− * Redistributions of source code must retain the above copyright
818− notice, this list of conditions and the following disclaimer.
819−
820− * Redistributions in binary form must reproduce the above
821− copyright notice, this list of conditions and the following
822− disclaimer in the documentation and/or other materials provided
823− with the distribution.
824−
825− * Neither the name of Herbert Valerio Riedel nor the names of other
826− contributors may be used to endorse or promote products derived
827− from this software without specific prior written permission.
828−
829− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
830− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
831− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
832− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
833− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
834− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
835− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
836− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
837− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
838− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
839− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
840−
841−mtl LICENSE file:
842−
843− The Glasgow Haskell Compiler License
844−
845− Copyright 2004, The University Court of the University of Glasgow.
846− All rights reserved.
847−
848− Redistribution and use in source and binary forms, with or without
849− modification, are permitted provided that the following conditions are met:
850−
851− - Redistributions of source code must retain the above copyright notice,
852− this list of conditions and the following disclaimer.
853−
854− - Redistributions in binary form must reproduce the above copyright notice,
855− this list of conditions and the following disclaimer in the documentation
856− and/or other materials provided with the distribution.
857−
858− - Neither name of the University nor the names of its contributors may be
859− used to endorse or promote products derived from this software without
860− specific prior written permission.
861−
862− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
863− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
864− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
865− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
866− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
867− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
868− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
869− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
870− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
871− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
872− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
873− DAMAGE.
874−
875−nats LICENSE file:
876−
877− Copyright 2011-2014 Edward Kmett
878−
879− All rights reserved.
880−
881− Redistribution and use in source and binary forms, with or without
882− modification, are permitted provided that the following conditions
883− are met:
884−
885− 1. Redistributions of source code must retain the above copyright
886− notice, this list of conditions and the following disclaimer.
887−
888− 2. Redistributions in binary form must reproduce the above copyright
889− notice, this list of conditions and the following disclaimer in the
890− documentation and/or other materials provided with the distribution.
891−
892− 3. Neither the name of the author nor the names of his contributors
893− may be used to endorse or promote products derived from this software
894− without specific prior written permission.
895−
896− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
897− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
898− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
899− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
900− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
901− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
902− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
903− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
904− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
905− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
906− POSSIBILITY OF SUCH DAMAGE.
907−
908−old-locale LICENSE file:
909−
910− This library (libraries/base) is derived from code from two
911− sources:
912−
913− * Code from the GHC project which is largely (c) The University of
914− Glasgow, and distributable under a BSD-style license (see below),
915−
916− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
917− and freely redistributable (but see the full license for
918− restrictions).
919−
920− The full text of these licenses is reproduced below. Both of the
921− licenses are BSD-style or compatible.
922−
923− -----------------------------------------------------------------------------
924−
925− The Glasgow Haskell Compiler License
926−
927− Copyright 2004, The University Court of the University of Glasgow.
928− All rights reserved.
929−
930− Redistribution and use in source and binary forms, with or without
931− modification, are permitted provided that the following conditions are met:
932−
933− - Redistributions of source code must retain the above copyright notice,
934− this list of conditions and the following disclaimer.
935−
936− - Redistributions in binary form must reproduce the above copyright notice,
937− this list of conditions and the following disclaimer in the documentation
938− and/or other materials provided with the distribution.
939−
940− - Neither name of the University nor the names of its contributors may be
941− used to endorse or promote products derived from this software without
942− specific prior written permission.
943−
944− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
945− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
946− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
947− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
948− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
949− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
950− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
951− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
952− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
953− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
954− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
955− DAMAGE.
956−
957− -----------------------------------------------------------------------------
958−
959− Code derived from the document "Report on the Programming Language
960− Haskell 98", is distributed under the following license:
961−
962− Copyright (c) 2002 Simon Peyton Jones
963−
964− The authors intend this Report to belong to the entire Haskell
965− community, and so we grant permission to copy and distribute it for
966− any purpose, provided that it is reproduced in its entirety,
967− including this Notice. Modified versions of this Report may also be
968− copied and distributed for any purpose, provided that the modified
969− version is clearly presented as such, and that it does not claim to
970− be a definition of the Haskell 98 Language.
971−
972− -----------------------------------------------------------------------------
973−
974−optparse-applicative LICENSE file:
975−
976− Copyright (c) 2012, Paolo Capriotti
977−
978− All rights reserved.
979−
980− Redistribution and use in source and binary forms, with or without
981− modification, are permitted provided that the following conditions are met:
982−
983− * Redistributions of source code must retain the above copyright
984− notice, this list of conditions and the following disclaimer.
985−
986− * Redistributions in binary form must reproduce the above
987− copyright notice, this list of conditions and the following
988− disclaimer in the documentation and/or other materials provided
989− with the distribution.
990−
991− * Neither the name of Paolo Capriotti nor the names of other
992− contributors may be used to endorse or promote products derived
993− from this software without specific prior written permission.
994−
995− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
996− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
997− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
998− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
999− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1000− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1001− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1002− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1003− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1004− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1005− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1006−
1007−parsec LICENSE file:
1008−
1009− Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.
1010−
1011− Redistribution and use in source and binary forms, with or without
1012− modification, are permitted provided that the following conditions are met:
1013−
1014− * Redistributions of source code must retain the above copyright notice,
1015− this list of conditions and the following disclaimer.
1016− * Redistributions in binary form must reproduce the above copyright
1017− notice, this list of conditions and the following disclaimer in the
1018− documentation and/or other materials provided with the distribution.
1019−
1020− This software is provided by the copyright holders "as is" and any express or
1021− implied warranties, including, but not limited to, the implied warranties of
1022− merchantability and fitness for a particular purpose are disclaimed. In no
1023− event shall the copyright holders be liable for any direct, indirect,
1024− incidental, special, exemplary, or consequential damages (including, but not
1025− limited to, procurement of substitute goods or services; loss of use, data,
1026− or profits; or business interruption) however caused and on any theory of
1027− liability, whether in contract, strict liability, or tort (including
1028− negligence or otherwise) arising in any way out of the use of this software,
1029− even if advised of the possibility of such damage.
1030−
1031−pattern-arrows LICENSE file:
1032−
1033− The MIT License (MIT)
1034−
1035− Copyright (c) 2013 Phil Freeman
1036−
1037− Permission is hereby granted, free of charge, to any person obtaining a copy of
1038− this software and associated documentation files (the "Software"), to deal in
1039− the Software without restriction, including without limitation the rights to
1040− use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
1041− the Software, and to permit persons to whom the Software is furnished to do so,
1042− subject to the following conditions:
1043−
1044− The above copyright notice and this permission notice shall be included in all
1045− copies or substantial portions of the Software.
1046−
1047− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
1048− IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
1049− FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
1050− COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
1051− IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
1052− CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
1053−
1054−pretty LICENSE file:
1055−
1056− This library (libraries/pretty) is derived from code from
1057− the GHC project which is largely (c) The University of
1058− Glasgow, and distributable under a BSD-style license (see below).
1059−
1060− -----------------------------------------------------------------------------
1061−
1062− The Glasgow Haskell Compiler License
1063−
1064− Copyright 2004, The University Court of the University of Glasgow.
1065− All rights reserved.
1066−
1067− Redistribution and use in source and binary forms, with or without
1068− modification, are permitted provided that the following conditions are met:
1069−
1070− - Redistributions of source code must retain the above copyright notice,
1071− this list of conditions and the following disclaimer.
1072−
1073− - Redistributions in binary form must reproduce the above copyright notice,
1074− this list of conditions and the following disclaimer in the documentation
1075− and/or other materials provided with the distribution.
1076−
1077− - Neither name of the University nor the names of its contributors may be
1078− used to endorse or promote products derived from this software without
1079− specific prior written permission.
1080−
1081− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1082− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1083− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1084− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1085− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1086− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1087− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1088− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1089− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1090− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1091− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1092− DAMAGE.
1093−
1094− -----------------------------------------------------------------------------
1095−
1096−primitive LICENSE file:
1097−
1098− Copyright (c) 2008-2009, Roman Leshchinskiy
1099− All rights reserved.
1100−
1101− Redistribution and use in source and binary forms, with or without
1102− modification, are permitted provided that the following conditions are met:
1103−
1104− - Redistributions of source code must retain the above copyright notice,
1105− this list of conditions and the following disclaimer.
1106−
1107− - Redistributions in binary form must reproduce the above copyright notice,
1108− this list of conditions and the following disclaimer in the documentation
1109− and/or other materials provided with the distribution.
1110−
1111− - Neither name of the University nor the names of its contributors may be
1112− used to endorse or promote products derived from this software without
1113− specific prior written permission.
1114−
1115− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1116− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1117− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1118− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1119− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1120− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1121− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1122− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1123− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1124− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1125− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1126− DAMAGE.
1127−
1128−
1129−process LICENSE file:
1130−
1131− This library (libraries/process) is derived from code from two
1132− sources:
1133−
1134− * Code from the GHC project which is largely (c) The University of
1135− Glasgow, and distributable under a BSD-style license (see below),
1136−
1137− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1138− and freely redistributable (but see the full license for
1139− restrictions).
1140−
1141− The full text of these licenses is reproduced below. Both of the
1142− licenses are BSD-style or compatible.
1143−
1144− -----------------------------------------------------------------------------
1145−
1146− The Glasgow Haskell Compiler License
1147−
1148− Copyright 2004, The University Court of the University of Glasgow.
1149− All rights reserved.
1150−
1151− Redistribution and use in source and binary forms, with or without
1152− modification, are permitted provided that the following conditions are met:
1153−
1154− - Redistributions of source code must retain the above copyright notice,
1155− this list of conditions and the following disclaimer.
1156−
1157− - Redistributions in binary form must reproduce the above copyright notice,
1158− this list of conditions and the following disclaimer in the documentation
1159− and/or other materials provided with the distribution.
1160−
1161− - Neither name of the University nor the names of its contributors may be
1162− used to endorse or promote products derived from this software without
1163− specific prior written permission.
1164−
1165− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1166− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1167− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1168− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1169− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1170− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1171− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1172− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1173− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1174− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1175− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1176− DAMAGE.
1177−
1178− -----------------------------------------------------------------------------
1179−
1180− Code derived from the document "Report on the Programming Language
1181− Haskell 98", is distributed under the following license:
1182−
1183− Copyright (c) 2002 Simon Peyton Jones
1184−
1185− The authors intend this Report to belong to the entire Haskell
1186− community, and so we grant permission to copy and distribute it for
1187− any purpose, provided that it is reproduced in its entirety,
1188− including this Notice. Modified versions of this Report may also be
1189− copied and distributed for any purpose, provided that the modified
1190− version is clearly presented as such, and that it does not claim to
1191− be a definition of the Haskell 98 Language.
1192−
1193− -----------------------------------------------------------------------------
1194−
1195−rts LICENSE file:
1196−
1197− Package not found: No such package in package index
1198−
1199−safe LICENSE file:
1200−
1201− Copyright Neil Mitchell 2007-2014.
1202− All rights reserved.
1203−
1204− Redistribution and use in source and binary forms, with or without
1205− modification, are permitted provided that the following conditions are
1206− met:
1207−
1208− * Redistributions of source code must retain the above copyright
1209− notice, this list of conditions and the following disclaimer.
1210−
1211− * Redistributions in binary form must reproduce the above
1212− copyright notice, this list of conditions and the following
1213− disclaimer in the documentation and/or other materials provided
1214− with the distribution.
1215−
1216− * Neither the name of Neil Mitchell nor the names of other
1217− contributors may be used to endorse or promote products derived
1218− from this software without specific prior written permission.
1219−
1220− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1221− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1222− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1223− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1224− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1225− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1226− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1227− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1228− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1229− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1230− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1231−
1232−scientific LICENSE file:
1233−
1234− Copyright (c) 2013, Bas van Dijk
1235−
1236− All rights reserved.
1237−
1238− Redistribution and use in source and binary forms, with or without
1239− modification, are permitted provided that the following conditions are met:
1240−
1241− * Redistributions of source code must retain the above copyright
1242− notice, this list of conditions and the following disclaimer.
1243−
1244− * Redistributions in binary form must reproduce the above
1245− copyright notice, this list of conditions and the following
1246− disclaimer in the documentation and/or other materials provided
1247− with the distribution.
1248−
1249− * Neither the name of Bas van Dijk nor the names of other
1250− contributors may be used to endorse or promote products derived
1251− from this software without specific prior written permission.
1252−
1253− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1254− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1255− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1256− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1257− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1258− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1259− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1260− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1261− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1262− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1263− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1264−
1265−semigroups LICENSE file:
1266−
1267− Copyright 2011-2015 Edward Kmett
1268−
1269− All rights reserved.
1270−
1271− Redistribution and use in source and binary forms, with or without
1272− modification, are permitted provided that the following conditions
1273− are met:
1274−
1275− 1. Redistributions of source code must retain the above copyright
1276− notice, this list of conditions and the following disclaimer.
1277−
1278− 2. Redistributions in binary form must reproduce the above copyright
1279− notice, this list of conditions and the following disclaimer in the
1280− documentation and/or other materials provided with the distribution.
1281−
1282− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1283− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1284− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1285− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1286− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1287− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1288− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1289− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1290− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1291− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1292− POSSIBILITY OF SUCH DAMAGE.
1293−
1294−split LICENSE file:
1295−
1296− Copyright (c) 2008 Brent Yorgey, Louis Wasserman
1297−
1298− All rights reserved.
1299−
1300− Redistribution and use in source and binary forms, with or without
1301− modification, are permitted provided that the following conditions
1302− are met:
1303− 1. Redistributions of source code must retain the above copyright
1304− notice, this list of conditions and the following disclaimer.
1305− 2. Redistributions in binary form must reproduce the above copyright
1306− notice, this list of conditions and the following disclaimer in the
1307− documentation and/or other materials provided with the distribution.
1308− 3. Neither the name of the author nor the names of other contributors
1309− may be used to endorse or promote products derived from this software
1310− without specific prior written permission.
1311−
1312− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
1313− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
1314− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
1315− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
1316− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1317− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1318− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1319− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1320− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1321− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1322− SUCH DAMAGE.
1323−
1324−syb LICENSE file:
1325−
1326− This library (libraries/syb) is derived from code from several
1327− sources:
1328−
1329− * Code from the GHC project which is largely (c) The University of
1330− Glasgow, and distributable under a BSD-style license (see below),
1331−
1332− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1333− and freely redistributable (but see the full license for
1334− restrictions).
1335−
1336− * Code from the Haskell Foreign Function Interface specification,
1337− which is (c) Manuel M. T. Chakravarty and freely redistributable
1338− (but see the full license for restrictions).
1339−
1340− The full text of these licenses is reproduced below. All of the
1341− licenses are BSD-style or compatible.
1342−
1343− -----------------------------------------------------------------------------
1344−
1345− The Glasgow Haskell Compiler License
1346−
1347− Copyright 2004, The University Court of the University of Glasgow.
1348− All rights reserved.
1349−
1350− Redistribution and use in source and binary forms, with or without
1351− modification, are permitted provided that the following conditions are met:
1352−
1353− - Redistributions of source code must retain the above copyright notice,
1354− this list of conditions and the following disclaimer.
1355−
1356− - Redistributions in binary form must reproduce the above copyright notice,
1357− this list of conditions and the following disclaimer in the documentation
1358− and/or other materials provided with the distribution.
1359−
1360− - Neither name of the University nor the names of its contributors may be
1361− used to endorse or promote products derived from this software without
1362− specific prior written permission.
1363−
1364− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1365− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1366− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1367− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1368− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1369− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1370− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1371− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1372− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1373− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1374− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1375− DAMAGE.
1376−
1377− -----------------------------------------------------------------------------
1378−
1379− Code derived from the document "Report on the Programming Language
1380− Haskell 98", is distributed under the following license:
1381−
1382− Copyright (c) 2002 Simon Peyton Jones
1383−
1384− The authors intend this Report to belong to the entire Haskell
1385− community, and so we grant permission to copy and distribute it for
1386− any purpose, provided that it is reproduced in its entirety,
1387− including this Notice. Modified versions of this Report may also be
1388− copied and distributed for any purpose, provided that the modified
1389− version is clearly presented as such, and that it does not claim to
1390− be a definition of the Haskell 98 Language.
1391−
1392− -----------------------------------------------------------------------------
1393−
1394− Code derived from the document "The Haskell 98 Foreign Function
1395− Interface, An Addendum to the Haskell 98 Report" is distributed under
1396− the following license:
1397−
1398− Copyright (c) 2002 Manuel M. T. Chakravarty
1399−
1400− The authors intend this Report to belong to the entire Haskell
1401− community, and so we grant permission to copy and distribute it for
1402− any purpose, provided that it is reproduced in its entirety,
1403− including this Notice. Modified versions of this Report may also be
1404− copied and distributed for any purpose, provided that the modified
1405− version is clearly presented as such, and that it does not claim to
1406− be a definition of the Haskell 98 Foreign Function Interface.
1407−
1408− -----------------------------------------------------------------------------
1409−
1410−template-haskell LICENSE file:
1411−
1412−
1413− The Glasgow Haskell Compiler License
1414−
1415− Copyright 2002-2007, The University Court of the University of Glasgow.
1416− All rights reserved.
1417−
1418− Redistribution and use in source and binary forms, with or without
1419− modification, are permitted provided that the following conditions are met:
1420−
1421− - Redistributions of source code must retain the above copyright notice,
1422− this list of conditions and the following disclaimer.
1423−
1424− - Redistributions in binary form must reproduce the above copyright notice,
1425− this list of conditions and the following disclaimer in the documentation
1426− and/or other materials provided with the distribution.
1427−
1428− - Neither name of the University nor the names of its contributors may be
1429− used to endorse or promote products derived from this software without
1430− specific prior written permission.
1431−
1432− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1433− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1434− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1435− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1436− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1437− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1438− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1439− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1440− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1441− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1442− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1443− DAMAGE.
1444−
1445−
1446−terminfo LICENSE file:
1447−
1448− Copyright 2007, Judah Jacobson.
1449− All Rights Reserved.
1450−
1451− Redistribution and use in source and binary forms, with or without
1452− modification, are permitted provided that the following conditions are met:
1453−
1454− - Redistribution of source code must retain the above copyright notice,
1455− this list of conditions and the following disclamer.
1456−
1457− - Redistribution in binary form must reproduce the above copyright notice,
1458− this list of conditions and the following disclamer in the documentation
1459− and/or other materials provided with the distribution.
1460−
1461− THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
1462− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1463− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1464− DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
1465− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1466− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1467− SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1468− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1469− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
1470− USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1471−
1472−text LICENSE file:
1473−
1474− Copyright (c) 2008-2009, Tom Harper
1475− All rights reserved.
1476−
1477− Redistribution and use in source and binary forms, with or without
1478− modification, are permitted provided that the following conditions
1479− are met:
1480−
1481− * Redistributions of source code must retain the above copyright
1482− notice, this list of conditions and the following disclaimer.
1483−
1484− * Redistributions in binary form must reproduce the above
1485− copyright notice, this list of conditions and the following
1486− disclaimer in the documentation and/or other materials provided
1487− with the distribution.
1488−
1489− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1490− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1491− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1492− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1493− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1494− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1495− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1496− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1497− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1498− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1499− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1500−
1501−time LICENSE file:
1502−
1503− TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.
1504− Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.
1505−
1506− Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
1507−
1508− - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
1509−
1510− - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
1511−
1512− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1513−
1514−transformers LICENSE file:
1515−
1516− The Glasgow Haskell Compiler License
1517−
1518− Copyright 2004, The University Court of the University of Glasgow.
1519− All rights reserved.
1520−
1521− Redistribution and use in source and binary forms, with or without
1522− modification, are permitted provided that the following conditions are met:
1523−
1524− - Redistributions of source code must retain the above copyright notice,
1525− this list of conditions and the following disclaimer.
1526−
1527− - Redistributions in binary form must reproduce the above copyright notice,
1528− this list of conditions and the following disclaimer in the documentation
1529− and/or other materials provided with the distribution.
1530−
1531− - Neither name of the University nor the names of its contributors may be
1532− used to endorse or promote products derived from this software without
1533− specific prior written permission.
1534−
1535− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1536− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1537− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1538− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1539− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1540− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1541− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1542− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1543− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1544− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1545− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1546− DAMAGE.
1547−
1548−transformers-compat LICENSE file:
1549−
1550− Copyright 2012 Edward Kmett
1551−
1552− All rights reserved.
1553−
1554− Redistribution and use in source and binary forms, with or without
1555− modification, are permitted provided that the following conditions
1556− are met:
1557−
1558− 1. Redistributions of source code must retain the above copyright
1559− notice, this list of conditions and the following disclaimer.
1560−
1561− 2. Redistributions in binary form must reproduce the above copyright
1562− notice, this list of conditions and the following disclaimer in the
1563− documentation and/or other materials provided with the distribution.
1564−
1565− 3. Neither the name of the author nor the names of his contributors
1566− may be used to endorse or promote products derived from this software
1567− without specific prior written permission.
1568−
1569− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1570− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1571− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1572− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1573− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1574− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1575− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1576− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1577− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1578− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1579− POSSIBILITY OF SUCH DAMAGE.
1580−
1581−unix LICENSE file:
1582−
1583− The Glasgow Haskell Compiler License
1584−
1585− Copyright 2004, The University Court of the University of Glasgow.
1586− All rights reserved.
1587−
1588− Redistribution and use in source and binary forms, with or without
1589− modification, are permitted provided that the following conditions are met:
1590−
1591− - Redistributions of source code must retain the above copyright notice,
1592− this list of conditions and the following disclaimer.
1593−
1594− - Redistributions in binary form must reproduce the above copyright notice,
1595− this list of conditions and the following disclaimer in the documentation
1596− and/or other materials provided with the distribution.
1597−
1598− - Neither name of the University nor the names of its contributors may be
1599− used to endorse or promote products derived from this software without
1600− specific prior written permission.
1601−
1602− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1603− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1604− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1605− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1606− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1607− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1608− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1609− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1610− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1611− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1612− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1613− DAMAGE.
1614−
1615−unordered-containers LICENSE file:
1616−
1617− Copyright (c) 2010, Johan Tibell
1618−
1619− All rights reserved.
1620−
1621− Redistribution and use in source and binary forms, with or without
1622− modification, are permitted provided that the following conditions are met:
1623−
1624− * Redistributions of source code must retain the above copyright
1625− notice, this list of conditions and the following disclaimer.
1626−
1627− * Redistributions in binary form must reproduce the above
1628− copyright notice, this list of conditions and the following
1629− disclaimer in the documentation and/or other materials provided
1630− with the distribution.
1631−
1632− * Neither the name of Johan Tibell nor the names of other
1633− contributors may be used to endorse or promote products derived
1634− from this software without specific prior written permission.
1635−
1636− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1637− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1638− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1639− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1640− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1641− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1642− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1643− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1644− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1645− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1646− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1647−
1648−utf8-string LICENSE file:
1649−
1650− * Copyright (c) 2007, Galois Inc.
1651− * All rights reserved.
1652− *
1653− * Redistribution and use in source and binary forms, with or without
1654− * modification, are permitted provided that the following conditions are met:
1655− * * Redistributions of source code must retain the above copyright
1656− * notice, this list of conditions and the following disclaimer.
1657− * * Redistributions in binary form must reproduce the above copyright
1658− * notice, this list of conditions and the following disclaimer in the
1659− * documentation and/or other materials provided with the distribution.
1660− * * Neither the name of Galois Inc. nor the
1661− * names of its contributors may be used to endorse or promote products
1662− * derived from this software without specific prior written permission.
1663− *
1664− * THIS SOFTWARE IS PROVIDED BY Galois Inc. ``AS IS'' AND ANY
1665− * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1666− * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1667− * DISCLAIMED. IN NO EVENT SHALL Galois Inc. BE LIABLE FOR ANY
1668− * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
1669− * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
1670− * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1671− * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1672− * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
1673− * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1674−
1675−vector LICENSE file:
1676−
1677− Copyright (c) 2008-2012, Roman Leshchinskiy
1678− All rights reserved.
1679−
1680− Redistribution and use in source and binary forms, with or without
1681− modification, are permitted provided that the following conditions are met:
1682−
1683− - Redistributions of source code must retain the above copyright notice,
1684− this list of conditions and the following disclaimer.
1685−
1686− - Redistributions in binary form must reproduce the above copyright notice,
1687− this list of conditions and the following disclaimer in the documentation
1688− and/or other materials provided with the distribution.
1689−
1690− - Neither name of the University nor the names of its contributors may be
1691− used to endorse or promote products derived from this software without
1692− specific prior written permission.
1693−
1694− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1695− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1696− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1697− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1698− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1699− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1700− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1701− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1702− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1703− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1704− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1705− DAMAGE.
1706−
1707−
1708−void LICENSE file:
1709−
1710− Copyright 2013 Edward Kmett
1711−
1712− All rights reserved.
1713−
1714− Redistribution and use in source and binary forms, with or without
1715− modification, are permitted provided that the following conditions
1716− are met:
1717−
1718− 1. Redistributions of source code must retain the above copyright
1719− notice, this list of conditions and the following disclaimer.
1720−
1721− 2. Redistributions in binary form must reproduce the above copyright
1722− notice, this list of conditions and the following disclaimer in the
1723− documentation and/or other materials provided with the distribution.
1724−
1725− 3. Neither the name of the author nor the names of his contributors
1726− may be used to endorse or promote products derived from this software
1727− without specific prior written permission.
1728−
1729− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1730− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1731− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1732− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1733− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1734− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1735− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1736− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1737− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1738− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1739− POSSIBILITY OF SUCH DAMAGE.
174010
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Author name here nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README-go.mdnew file+48
@@ -0,0 +1,48 @@
1+
2+### psgo
3+
4+#### Performance
5+
6+* No runtime system beyond some support types and functions
7+* Uses PureScript's normal tail call optimization techniques for generated Go code
8+
9+#### Differences from PureScript:
10+
11+* Foreign imports/exports are Go instead of JavaScript – see [standard library foreign implementations](https://github.com/andyarvanitis/purescript-native-go-ffi)
12+* No Go-specific REPL
13+
14+#### Other notes:
15+
16+* The provided `Any` type is just an alias for `interface{}`
17+* PureScript types are represented in Go with:
18+
19+ | PureScript | Go |
20+ |------------|----|
21+ |`Array` | `[]Any`|
22+ |`String` | `string`|
23+ |`Number` | `float64`|
24+ |`Int` | `int`|
25+ |`Char` | `string` (single UTF-8 entity)|
26+ |`Boolean` | `bool`|
27+ |Records | `map[string]Any`|
28+
29+#### Future ideas:
30+
31+* Nice facilities (modules) for concurrency/parallelism, using goroutines
32+
33+
34+#### Getting Started
35+This assumes you are running macOS (OS X) or a Unix-like system (Linux, *BSD, etc.).
36+
37+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.
38+
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+
41+1. Add the `backend = "psgo"` option to your `spago.dhall` file. That way `spago` will use the psgo backend when compiling.
42+
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 `spago build`.
45+
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/`.
47+
48+---
README.md+33−17
@@ -1,25 +1,41 @@
1−[![PureScript](logo.png)](http://purescript.org)
1+[![PureScript](https://raw.githubusercontent.com/purescript/purescript/master/logo.png)](http://purescript.org)
22
3−A small strongly typed programming language with expressive types that compiles to Javascript, written in and inspired by Haskell.
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.
44
5−[![Hackage](https://budueba.com/hackage/purescript)](http://hackage.haskell.org/package/purescript) [![Build Status](https://secure.travis-ci.org/purescript/purescript.png?branch=master)](http://travis-ci.org/purescript/purescript) [![Coverage Status](https://coveralls.io/repos/purescript/purescript/badge.png?branch=master)](https://coveralls.io/r/purescript/purescript?branch=master)
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).
66
7−## Language info
7+#### Platforms
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:
9+ * macOS Mojave 10.14.5 – full test suite
10+ * For C++, Xcode 10.2.1's `clang` was used
11+ * For Go, `go` version 1.12.7 was used
12+ * Windows 10 x64 – full test suite
13+ * C++: Visual Studio 2017 and `clang`
14+ * Go: `go` version 1.12.7
15+ * Linux Debian 9.5 amd64 – full test suite (C++)
16+ * Default versions of `clang` and `gcc`
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`
820
9−- [PureScript home](http://purescript.org)
10−- [Releases & changelog](https://github.com/purescript/purescript/releases)
11−- [Contributing to PureScript](https://github.com/purescript/purescript/blob/master/CONTRIBUTING.md)
1221
13−## Resources
22+#### Requirements for building `pscpp` and `psgo`
1423
15−- [PureScript book](https://leanpub.com/purescript/read)
16−- [Wiki](http://wiki.purescript.org)
17−- [Try PureScript](http://try.purescript.org)
18−- [Pursuit package search engine](http://pursuit.purescript.org/)
19−- [Core library documentation index](http://functorial.com/psc-pages/docs)
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/))
2025
21−## Help!
26+#### Requirements for using PureScript + purescript-native
2227
23−- [#purescript IRC @ FreeNode](http://webchat.freenode.net/?channels=purescript)
24−- [PureScript on StackOverflow](http://stackoverflow.com/questions/tagged/purescript)
25−- [Google Group](https://groups.google.com/forum/#!forum/purescript)
28+* A recent version (0.13+) of [purescript](https://github.com/purescript/purescript/releases).
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.
32+* For `psgo`, the [Go toolchain](https://golang.org) for your system
33+ * You can use your favorite PureScript package manager and build tools – but for simplicity, [`spago`](https://github.com/spacchetti/spago) is recommended.
34+
35+
36+#### For more information and a Getting Started guide, please see
37+* [`pscpp`](https://github.com/andyarvanitis/purescript-native/blob/cpp/README-cpp.md)
38+* [`psgo`](https://github.com/andyarvanitis/purescript-native/blob/golang/README-go.md)
39+
40+
41+---
Setup.hs−4
@@ -1,6 +1,2 @@
1−module Main where
2−
31import Distribution.Simple
4−
5−main :: IO ()
62main = defaultMain
app/Main.hsnew file+250
@@ -0,0 +1,250 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RankNTypes #-}
3+{-# LANGUAGE TemplateHaskell #-}
4+
5+module Main where
6+
7+import Control.Monad (when)
8+import qualified Control.Monad.Parallel as Par
9+import Data.Aeson
10+import Data.Aeson.Types
11+import Data.Char
12+import Data.FileEmbed (embedFile)
13+import Data.List (delete, intercalate, isPrefixOf, nub, partition, (\\))
14+import Data.Maybe
15+import Data.Monoid ((<>))
16+import Data.Version
17+import Control.Monad.Supply
18+import Control.Monad.Supply.Class
19+import Text.Printf
20+
21+import System.Environment
22+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory, getModificationTime)
23+import System.FilePath ((</>), joinPath, splitDirectories, takeDirectory)
24+import System.FilePath.Find
25+import System.Process
26+
27+import Data.Text (Text)
28+import qualified Data.Text as T
29+import qualified Data.Text.Encoding as T
30+import qualified Data.Text.Lazy as L
31+import qualified Data.Text.Lazy.Encoding as L
32+import qualified Data.ByteString as B
33+
34+import Development.GitRev
35+
36+import Language.PureScript.AST.Literals
37+import Language.PureScript.CoreFn
38+import Language.PureScript.CoreFn.FromJSON
39+
40+import CodeGen.IL
41+import CodeGen.IL.Common
42+import CodeGen.IL.Printer
43+
44+import Tests
45+
46+data Command = Build | Run (Maybe String)
47+
48+parseJson :: Text -> Value
49+parseJson text
50+ | Just fileJson <- decode . L.encodeUtf8 $ L.fromStrict text = fileJson
51+ | otherwise = error "Bad json"
52+
53+jsonToModule :: Value -> Module Ann
54+jsonToModule value =
55+ case parse moduleFromJSON value of
56+ Success (_, r) -> r
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')
77+
78+main :: IO ()
79+main = do
80+ args <- getArgs
81+ -- let (opts, files) = partition (isPrefixOf "--") args
82+ let (opts, moduleName, files) = splitArgs args
83+ opts' = (map . map) toLower opts
84+ if "--tests" `elem` opts'
85+ then runTests
86+ else do
87+ if "--help" `elem` opts' || "--version" `elem` opts'
88+ then do
89+ when ("--help" `elem` opts') $ do
90+ putStrLn help
91+ when ("--version" `elem` opts') $ do
92+ let branch = $(gitBranch)
93+ details | branch == "golang" = "master, commit " ++ $(gitHash)
94+ | otherwise = branch
95+ putStrLn $ details ++ if $(gitDirty) then " (DIRTY)" else ""
96+ else do
97+ if null files
98+ then do
99+ currentDir <- getCurrentDirectory
100+ processFiles opts' [currentDir]
101+ else
102+ processFiles opts' files
103+ if "--run" `elem` opts
104+ then runBuildTool $ Run moduleName
105+ else when ("--no-build" `notElem` opts) $
106+ runBuildTool Build
107+ return ()
108+ where
109+ processFiles :: [String] -> [FilePath] -> IO ()
110+ processFiles opts [file] = do
111+ isDir <- doesDirectoryExist file
112+ if isDir then do
113+ files <- find always (fileName ==? corefn) file
114+ if null files
115+ then errorNoCorefnFiles
116+ else generateFiles opts files
117+ else generateFiles opts [file]
118+ processFiles opts files = do
119+ generateFiles opts files
120+ basePath :: [FilePath] -> FilePath
121+ basePath files =
122+ let filepath = takeDirectory (head files) in
123+ joinPath $ (init $ splitDirectories filepath)
124+ generateFiles :: [String] -> [FilePath] -> IO ()
125+ generateFiles opts files = do
126+ let baseOutpath = basePath files
127+ writeSupportFiles baseOutpath
128+ Par.mapM (generateCode opts baseOutpath) files
129+ return ()
130+ runBuildTool :: Command -> IO ()
131+ runBuildTool cmd = do
132+ project <- projectEnv
133+ case cmd of
134+ Build -> do
135+ callProcess "go" ["build", T.unpack project </> modPrefix' </> "Main"]
136+ Run moduleName -> do
137+ callProcess "go" ["run", T.unpack project </> modPrefix' </> fromMaybe "Main" moduleName]
138+ return ()
139+
140+generateCode :: [String] -> FilePath -> FilePath -> IO ()
141+generateCode opts baseOutpath jsonFile = do
142+ jsonModTime <- getModificationTime jsonFile
143+ let filepath = takeDirectory jsonFile
144+ dirparts = splitDirectories $ filepath
145+ mname = last dirparts
146+ basedir = joinPath $ init dirparts
147+ mname' = T.pack mname
148+ possibleFileName = basedir </> (T.unpack mname') </> implFileName mname'
149+ exists <- doesFileExist possibleFileName
150+ if exists
151+ then do
152+ modTime <- getModificationTime possibleFileName
153+ when (modTime < jsonModTime) $
154+ transpile opts baseOutpath jsonFile
155+ else transpile opts baseOutpath jsonFile
156+
157+transpile :: [String] -> FilePath -> FilePath -> IO ()
158+transpile opts baseOutpath jsonFile = do
159+ jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
160+ project <- projectEnv
161+ let module' = jsonToModule $ parseJson jsonText
162+ ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' project)
163+ let mn = moduleNameToIL' $ moduleName module'
164+ implementation = prettyPrintIL asts
165+ outpath = joinPath [baseOutpath, T.unpack mn]
166+ implPath = outpath </> implFileName mn
167+ createDirectoryIfMissing True outpath
168+ putStrLn implPath
169+ B.writeFile implPath $ T.encodeUtf8 (implHeader <> implementation <> implFooter)
170+
171+writeSupportFiles :: FilePath -> IO ()
172+writeSupportFiles baseOutpath = do
173+ currentDir <- getCurrentDirectory
174+ let outputdir = T.pack $ baseOutpath \\ currentDir
175+ ffiOutpath = currentDir </> subdir
176+ createDirectoryIfMissing True baseOutpath
177+ createDirectoryIfMissing True ffiOutpath
178+ writeModuleFile outputdir currentDir $(embedFile "support/go.mod.working")
179+ writeModuleFile outputdir baseOutpath $(embedFile "support/go.mod.output")
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
185+ let goModSource = path </> "go.mod"
186+ goModSourceExists <- doesFileExist goModSource
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'
194+ B.writeFile goModSource $ T.encodeUtf8 modText'
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"
201+ loaderSourceExists <- doesFileExist loaderSource
202+ when (not loaderSourceExists) $ do
203+ B.writeFile loaderSource loaderText
204+
205+implFileName :: Text -> FilePath
206+implFileName mn = ((\c -> if c == '.' then '_' else c) <$> T.unpack mn) <> ".go"
207+
208+projectEnv :: IO Text
209+projectEnv = do
210+ T.pack . fromMaybe defaultProject <$> lookupEnv goproject
211+
212+help :: String
213+help = "Usage: psgo OPTIONS COREFN-FILES\n\
214+ \ PureScript to native (via go) compiler\n\n\
215+ \Available options:\n\
216+ \ --help Show this help text\n\n\
217+ \ --version Show the version number\n\n\
218+ \ --run Run the generated go code directly, without building an\n\
219+ \ executable\n\
220+ \ --no-build Generate go source files, but do not build an executable\n\
221+ \ --tests Run test cases (under construction)\n\n\
222+ \See also:\n\
223+ \ purs compile --help\n"
224+
225+corefn :: String
226+corefn = "corefn.json"
227+
228+goSrc :: String
229+goSrc = ".go"
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+
246+errorNoCorefnFiles :: IO ()
247+errorNoCorefnFiles = do
248+ ioError . userError $ "no compiled purescript '" <> corefn <> "' files found –\n" <>
249+ " make sure to use the '--codegen corefn' option with your purs\n" <>
250+ " project build tool"
bundle/.gitignoredeleted−3
@@ -1,3 +0,0 @@
1−build/
2−*.tar.gz
3−*.sha
bundle/READMEdeleted−20
@@ -1,20 +0,0 @@
1− ____ ____ _ _
2−| _ \ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_
3−| |_) | | | | '__/ _ \___ \ / __| '__| | '_ \| __|
4−| __/| |_| | | | __/___) | (__| | | | |_) | |_
5−|_| \__,_|_| \___|____/ \___|_| |_| .__/ \__|
6− |_|
7−
8−Installation Instructions
9−-------------------------
10−
11−This bundle contains the following executables:
12−
13−- psc The PureScript compiler (generates JavaScript for use
14− in the browser)
15−- psc-make The PureScript compiler (generates CommonJS modules)
16−- psci The PureScript interactive module (requires NodeJS)
17−- psc-docs A documentation generator
18−
19−Copy these files anywhere on your PATH.
20−
bundle/build.shdeleted−43
@@ -1,43 +0,0 @@
1−set -e
2−
3−SCRIPTPATH=$( cd "$(dirname "$0")" ; pwd -P )
4−
5−OS=$1
6−
7−if [ -z $OS ]
8−then
9− echo "Usage: build.sh osname"
10− exit 1
11−fi
12−
13−pushd ${SCRIPTPATH} > /dev/null
14−
15−# Make the staging directory
16−mkdir -p build/purescript/
17−
18−# Strip the binaries
19−strip ../dist/build/psc/psc
20−strip ../dist/build/psci/psci
21−strip ../dist/build/psc-make/psc-make
22−strip ../dist/build/psc-docs/psc-docs
23−
24−# Copy files to staging directory
25−cp ../dist/build/psc/psc build/purescript/
26−cp ../dist/build/psci/psci build/purescript/
27−cp ../dist/build/psc-make/psc-make build/purescript/
28−cp ../dist/build/psc-docs/psc-docs build/purescript/
29−cp README build/purescript/
30−cp ../LICENSE build/purescript/
31−
32−# Make the binary bundle
33−pushd build > /dev/null
34−tar -zcvf ../$OS.tar.gz purescript
35−popd > /dev/null
36−
37−# Calculate the SHA hash
38−shasum $OS.tar.gz > $OS.sha
39−
40−# Remove the staging directory
41−rm -rf build/
42−
43−popd > /dev/null
bundle/winbuild.shdeleted−40
@@ -1,40 +0,0 @@
1−## This Windows-specific version of build.sh can be run in an msys environment
2−## to create a .tar.gz bundle for Windows users.
3−## msysgit contains all of the pieces needed to run this script.
4−
5−set -e
6−
7−SCRIPTPATH=$( cd "$(dirname "$0")" ; pwd -P )
8−
9−pushd ${SCRIPTPATH}
10−
11−# Make the staging directory
12−mkdir -p build/purescript/
13−
14−# Strip the binaries
15−strip ../dist/build/psc/psc.exe
16−strip ../dist/build/psci/psci.exe
17−strip ../dist/build/psc-make/psc-make.exe
18−strip ../dist/build/psc-docs/psc-docs.exe
19−
20−# Copy files to staging directory
21−cp ../dist/build/psc/psc.exe build/purescript/
22−cp ../dist/build/psci/psci.exe build/purescript/
23−cp ../dist/build/psc-make/psc-make.exe build/purescript/
24−cp ../dist/build/psc-docs/psc-docs.exe build/purescript/
25−cp README build/purescript/
26−cp ../LICENSE build/purescript/
27−
28−# Make the binary bundle
29−pushd build
30−tar -zcvf ../win64.tar.gz purescript
31−popd
32−
33−# Calculate the MD5 hash
34−md5sum win64.tar.gz > win64.md5
35−
36−# Remove the staging directory
37−rm -rf build/
38−
39−popd
40−
core-tests/.gitignoredeleted−2
@@ -1,2 +0,0 @@
1−bower_components/
2−output/
core-tests/test-everything.shdeleted−50
@@ -1,50 +0,0 @@
1−#!/bin/bash
2−
3−set -e
4−
5−npm install -g bower
6−
7−bower i purescript-prelude \
8− purescript-eff \
9− purescript-st \
10− purescript-integers \
11− purescript-functions \
12− purescript-console \
13− purescript-profunctor \
14− purescript-contravariant \
15− purescript-parallel \
16− purescript-control \
17− purescript-tailrec \
18− purescript-maps \
19− purescript-free \
20− purescript-transformers \
21− purescript-monad-eff \
22− purescript-exists \
23− purescript-monoid \
24− purescript-either \
25− purescript-maybe \
26− purescript-inject \
27− purescript-graphs \
28− purescript-enums \
29− purescript-unfoldable \
30− purescript-coproducts \
31− purescript-lazy \
32− purescript-distributive \
33− purescript-identity \
34− purescript-bifunctors \
35− purescript-const \
36− purescript-sets \
37− purescript-quickcheck \
38− purescript-foreign \
39− purescript-foldable-traversable \
40− purescript-tuples \
41− purescript-strings \
42− purescript-arrays \
43− purescript-random \
44− purescript-refs \
45− purescript-globals \
46− purescript-exceptions \
47− purescript-validation \
48− purescript-math
49−
50−find bower_components/**/src -name '*.purs' | xargs ../dist/build/psc-make/psc-make
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+}
examples/.gitignoredeleted−1
@@ -1 +0,0 @@
1−shelltest/tests
examples/failing/365.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−class C a where
4− f :: a -> a
5− g :: a -> a
6−
7−instance cS :: C String where
8− f s = s
9− g = f
10−
11−main = g "Done"
examples/failing/438.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−data Fix f = In (f (Fix f))
4−
5−instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where
6− (==) (In f) (In g) = f == g
7− (/=) a b = not (a == b)
8−
9−example = In [] == In []
examples/failing/ArrayType.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−
5−bar :: Number -> Number -> Number
6−bar n m = n + m
7−
8−foo = x `bar` y
9− where
10− x = 1
11− y = []
examples/failing/Arrays.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− test = \arr -> arr !! (0 !! 0)
examples/failing/Do.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−test1 = do let x = 1
4−
5−test2 y = do x <- y
6−
7−test3 = do return 1
8− return 2
examples/failing/DuplicateDeclarationsInLet.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−foo = a
4− where
5− a :: Number
6− a = 1
7−
8− a :: Number
9− a = 2
examples/failing/DuplicateProperties1.pursdeleted−9
@@ -1,9 +0,0 @@
1−module DuplicateProperties where
2−
3−foreign import data Test :: # * -> *
4−
5−foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r
6−
7−foreign import hasX "" :: Test (x :: Unit, y :: Unit)
8−
9−baz = subtractX (subtractX hasX)
examples/failing/DuplicateProperties2.pursdeleted−9
@@ -1,9 +0,0 @@
1−module DuplicateProperties where
2−
3−foreign import data Test :: # * -> *
4−
5−foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r
6−
7−foreign import hasX "" :: forall r. Test (x :: Unit, y :: Unit | r)
8−
9−baz = subtractX (subtractX hasX)
examples/failing/DuplicateTypeVars.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3−type Foo a a = a
examples/failing/Eff.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−import Debug.Trace
7−
8−test = pureST (do
9− ref <- newSTRef 0
10− trace "ST"
11− modifySTRef ref $ \n -> n + 1
12− readSTRef ref)
examples/failing/Foldable.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−class Foldable f where
4− fold :: forall a b. (a -> b -> b) -> b -> f a -> b
5− size :: forall a. f a -> Number
6−
7−data L a = C a (L a) | N
8−
9−instance foldableL :: Foldable L where
10− fold _ z N = z
11− fold f z (C x xs) = x `f` (fold f z xs)
12− size = fold (const ((+) 1.0)) 0.0
13−
14−x = size (C 1 (C 2 (C 3 N)))
examples/failing/InstanceExport.pursdeleted−15
@@ -1,15 +0,0 @@
1−module InstanceExport (S(..), f) where
2−
3−newtype S = S String
4−
5−class F a where
6− f :: a -> String
7−
8−instance fs :: F S where
9− f (S s) = s
10−
11−module Test where
12−
13−import InstanceExport
14−
15−test = f $ S "Test"
examples/failing/KindError.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3− data KindError f a = One f | Two (f a)
examples/failing/Let.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3−test = let x = x in x
examples/failing/MPTCs.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−class Foo a where
4− f :: a -> a
5−
6−instance fooStringString :: Foo String String where
7− f a = a
examples/failing/MissingClassExport.pursdeleted−4
@@ -1,4 +0,0 @@
1−module Test (bar) where
2−
3− class Foo a where
4− bar :: a -> a
examples/failing/MissingClassMemberExport.pursdeleted−4
@@ -1,4 +0,0 @@
1−module Test (Foo) where
2−
3− class Foo a where
4− bar :: a -> a
examples/failing/MultipleErrors.pursdeleted−9
@@ -1,9 +0,0 @@
1−module MultipleErrors where
2−
3−foo :: Number -> Number
4−foo 0 = "Test"
5−foo n = bar (n - 1)
6−
7−bar :: Number -> Number
8−bar 0 = "Test"
9−bar n = foo (n - 1)
examples/failing/MultipleErrors2.pursdeleted−5
@@ -1,5 +0,0 @@
1−module MultipleErrors2 where
2−
3−foo = itDoesntExist
4−
5−bar = neitherDoesThis
examples/failing/MutRec.pursdeleted−5
@@ -1,5 +0,0 @@
1−module MutRec where
2−
3−x = y
4−
5−y = x
examples/failing/MutRec2.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3−x = x
examples/failing/NewtypeMultiArgs.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3−newtype Thing = Thing String Boolean
examples/failing/NewtypeMultiCtor.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3−newtype Thing = Thing String | Other
examples/failing/NoOverlap.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−data Foo = Foo
4−
5−instance showFoo1 :: Show Foo where
6− show _ = "Foo"
7−
8−instance showFoo2 :: Show Foo where
9− show _ = "Bar"
10−
11−test = show Foo
examples/failing/NullaryAbs.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3− func = \ -> "no"
examples/failing/Object.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3−test o = o.foo
4−
5−test1 = test {}
examples/failing/OverlappingArguments.pursdeleted−3
@@ -1,3 +0,0 @@
1−module OverlappingArguments where
2−
3−f x x = x
examples/failing/OverlappingBinders.pursdeleted−6
@@ -1,6 +0,0 @@
1−module OverlappingBinders where
2−
3−data S a = S a (S a)
4−
5−f x = case x of
6− (S y (S y@(S z zs))) -> y
examples/failing/OverlappingInstances.pursdeleted−11
@@ -1,11 +0,0 @@
1−module OverlappingInstances where
2−
3−data A = A
4−
5−instance showA1 :: Show A where
6− show A = "Instance 1"
7−
8−instance showA2 :: Show A where
9− show A = "Instance 2"
10−
11−main = Debug.Trace.trace $ show A
examples/failing/OverlappingInstances2.pursdeleted−23
@@ -1,23 +0,0 @@
1−module OverlappingInstances where
2−
3−data A = A | B
4−
5−instance eqA1 :: Eq A where
6− (==) A A = true
7− (==) B B = true
8− (==) _ _ = false
9− (/=) x y = not (x == y)
10−
11−instance eqA2 :: Eq A where
12− (==) _ _ = true
13− (/=) _ _ = false
14−
15−instance ordA :: Ord A where
16− compare A B = LT
17− compare B A = GT
18− compare _ _ = EQ
19−
20−test :: forall a. (Ord a) => a -> a -> String
21−test x y = show $ x == y
22−
23−main = Debug.Trace.trace $ test A B
examples/failing/OverlappingVars.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−class OverlappingVars a where
4− f :: a -> a
5−
6−data Foo a b = Foo a b
7−
8−instance overlappingVarsFoo :: OverlappingVars (Foo a a) where
9− f a = a
10−
11−test = f (Foo "" 0)
12−
examples/failing/Rank2Types.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− foreign import test :: (forall a. a -> a) -> Number
6−
7− test1 = test (\n -> n + 1)
examples/failing/Reserved.pursdeleted−4
@@ -1,4 +0,0 @@
1−module Main where
2−
3−(<) :: Number -> Number -> Number
4−(<) a b = !(a >= b)
examples/failing/RowConstructors1.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−data Foo = Bar
4−type Baz = { | Foo }
5−
6−main = Debug.Trace.trace "Done"
examples/failing/RowConstructors2.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−type Foo r = (x :: Number | r)
4−type Bar = { | Foo }
5−
6−main = Debug.Trace.trace "Done"
examples/failing/RowConstructors3.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−type Foo = { x :: Number }
4−type Bar = { | Foo }
5−
6−main = Debug.Trace.trace "Done"
examples/failing/SkolemEscape.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3− foreign import foo :: (forall a. a -> a) -> Number
4−
5− test = \x -> foo x
examples/failing/SkolemEscape2.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−
7−test _ = do
8− r <- runST (newSTRef 0)
9− return 0
examples/failing/Superclasses1.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−class Su a where
4− su :: a -> a
5−
6−class (Su a) <= Cl a where
7− cl :: a -> a -> a
8−
9−instance clNumber :: Cl Number where
10− cl n m = n + m
11−
examples/failing/Superclasses2.pursdeleted−9
@@ -1,9 +0,0 @@
1−module CycleInSuperclasses where
2−
3−class (Foo a) <= Bar a
4−
5−class (Bar a) <= Foo a
6−
7−instance barString :: Bar String
8−
9−instance fooString :: Foo String
examples/failing/Superclasses3.pursdeleted−5
@@ -1,5 +0,0 @@
1−module UnknownSuperclassTypeVar where
2−
3−class Foo a
4−
5−class (Foo b) <= Bar a
examples/failing/Superclasses4.pursdeleted−12
@@ -1,12 +0,0 @@
1−module OverlappingInstances where
2−
3−class Foo a
4−
5−instance foo1 :: Foo Number
6−
7−instance foo2 :: Foo Number
8−
9−test :: forall a. (Foo a) => a -> a
10−test a = a
11−
12−test1 = test 0
examples/failing/TopLevelCaseNoArgs.pursdeleted−4
@@ -1,4 +0,0 @@
1−module Main where
2− foo :: Number
3− foo = 1
4− foo = 2
examples/failing/TypeClassInstances.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−class A a where
4− a :: a -> String
5− b :: a -> Number
6−
7−instance aString :: A String where
8− a s = s
examples/failing/TypeClasses2.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude ()
4−
5−class Show a where
6− show :: a -> String
7−
8−test = show "testing"
examples/failing/TypeError.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− test = 1 ++ "A"
examples/failing/TypeSynonyms.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3−type T1 = Array T2
4−
5−type T2 = T1
examples/failing/TypeSynonyms2.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−class Foo a where
4− foo :: a -> String
5−
6−type Bar = String
7−
8−instance fooBar :: Foo Bar where
9− foo s = s
examples/failing/TypeSynonyms3.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−class Foo a where
4− foo :: a -> String
5−
6−type Bar = String
7−
8−instance fooBar :: Foo Bar where
9− foo s = s
examples/failing/TypeSynonyms4.pursdeleted−8
@@ -1,8 +0,0 @@
1−module TypeSynonyms4 where
2−
3−type F x y = x -> y
4−
5−type G x = F x
6−
7−f :: G String String -> String
8−f k = k "Done"
examples/failing/TypeSynonyms5.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Main where
2−
3−type T = T
examples/failing/TypeWildcards1.pursdeleted−4
@@ -1,4 +0,0 @@
1−module TypeWildcards where
2−
3−type Test = _
4−
examples/failing/TypeWildcards2.pursdeleted−4
@@ -1,4 +0,0 @@
1−module TypeWildcards where
2−
3−data Test = Test _
4−
examples/failing/TypeWildcards3.pursdeleted−7
@@ -1,7 +0,0 @@
1−module TypeWildcards where
2−
3−data Foo a = Foo
4−
5−instance showFoo :: Show (Foo _) where
6− show Foo = "Foo"
7−
examples/failing/UnderscoreModuleName.pursdeleted−3
@@ -1,3 +0,0 @@
1−module Bad_Module where
2−
3−main = Debug.Trace.trace "Done"
examples/failing/UnifyInTypeInstanceLookup.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−data Z = Z
4−data S n = S n
5−
6−data T
7−data F
8−
9−class EQ x y b
10−instance eqT :: EQ x x T
11−instance eqF :: EQ x y F
12−
13−foreign import test :: forall a b. (EQ a b T) => a -> b -> a
14−
15−foreign import anyNat :: forall a. a
16−
17−test1 = test anyNat (S Z)
examples/failing/UnknownType.pursdeleted−4
@@ -1,4 +0,0 @@
1−module Main where
2−
3−test :: Number -> Something
4−test = {}
examples/manual/QualifiedNames.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Data.Either where
2−
3−data Either a b = Left a | Right b
4−
5−module Main where
6−
7−either :: forall a b c. (a -> c) -> (b -> c) -> Data.Either.Either a b -> c
8−either f _ (Data.Either.Left x) = f x
9−either _ g (Data.Either.Right y) = g y
10−
11−main = Debug.Trace.trace (either id id (Data.Either.Left "Done"))
examples/manual/failing/ArgLengthMismatch.pursdeleted−4
@@ -1,4 +0,0 @@
1−module ArgLengthMismatch where
2−
3− f x y = true
4− f = false
examples/manual/failing/ExportExplicit.pursdeleted−5
@@ -1,5 +0,0 @@
1−-- should fail as z does not exist in the module
2−module M1 (x, y, z) where
3−
4− x = 1
5− y = 2
examples/manual/failing/ExportExplicit1.pursdeleted−14
@@ -1,14 +0,0 @@
1−module M1 (X(X)) where
2−
3− data X = X | Y
4−
5−module Main where
6−
7− import M1
8−
9− testX = X
10−
11− -- should fail as Y constructor is not exported from M1
12− testY = Y
13−
14− main = Debug.Trace.trace "Done"
examples/manual/failing/ExportExplicit2.pursdeleted−5
@@ -1,5 +0,0 @@
1−-- should fail as Y is not a data constructor for X
2−module M1 (X(Y)) where
3−
4− data X = X
5− data Y = Y
examples/manual/failing/ExportExplicit3.pursdeleted−13
@@ -1,13 +0,0 @@
1−module M1 (X(..)) where
2−
3− data X = X | Y
4− data Z = Z
5−
6−module Main where
7−
8− import M1
9−
10− -- should fail as Z is not exported from M1
11− testZ = M1.Z
12−
13− main = Debug.Trace.trace "Done"
examples/manual/failing/ImportExplicit.pursdeleted−7
@@ -1,7 +0,0 @@
1−module M1 where
2−
3− foo = "foo"
4−
5−module Main where
6−
7− import M1 (X(..))
examples/manual/failing/ImportExplicit2.pursdeleted−7
@@ -1,7 +0,0 @@
1−module M1 where
2−
3− data X = Y
4−
5−module Main where
6−
7− import M1 (X(Z, Q))
examples/manual/failing/ImportModule.pursdeleted−7
@@ -1,7 +0,0 @@
1−module M2 where
2−
3− data X = X
4−
5−module Main where
6−
7− import M1
examples/manual/failing/OrphanTypeDecl.pursdeleted−3
@@ -1,3 +0,0 @@
1−module OrphanTypeDecl where
2−
3− fn :: Number -> Boolean
examples/manual/failing/RedefinedFixity.pursdeleted−6
@@ -1,6 +0,0 @@
1−module RedefinedFixity where
2−
3− (!?) x y = x + y
4−
5− infix 2 !?
6− infix 2 !?
examples/manual/failing/RequiredHiddenType.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- exporting `a` should fail as `A` is hidden
2−module Foo (B(..), a, b) where
3−
4− data A = A
5− data B = B
6−
7− a = A
8− b = B
examples/manual/passing/ExportExplicit.pursdeleted−20
@@ -1,20 +0,0 @@
1−module M1 (X(X), Z(..), foo) where
2−
3− data X = X | Y
4− data Z = Z
5−
6− foo :: Number
7− foo = 0
8−
9− bar :: Number
10− bar = 1
11−
12−module Main where
13−
14− import M1
15−
16− testX = X
17− testZ = Z
18− testFoo = foo
19−
20− main = Debug.Trace.trace "Done"
examples/manual/passing/ExportExplicit2.pursdeleted−15
@@ -1,15 +0,0 @@
1−module M1 (bar) where
2−
3− foo :: Number
4− foo = 0
5−
6− bar :: Number
7− bar = foo
8−
9−module Main where
10−
11− import M1
12−
13− testBar = bar
14−
15− main = Debug.Trace.trace "Done"
examples/manual/passing/ExportedInstanceDeclarations.pursdeleted−41
@@ -1,41 +0,0 @@
1−
2−-- Tests that instances for non-exported classes / types do not appear in the
3−-- result of `exportedDeclarations`.
4−
5−module ExportedInstanceDeclarations
6− ( Const(..)
7− , Foo
8− , foo
9− ) where
10−
11−data Const a b = Const a
12−
13−class Foo a where
14− foo :: a
15−
16−data NonexportedType = NonexportedType
17−
18−class NonexportedClass a where
19− notExported :: a
20−
21−-- There are three places that a nonexported type or type class can occur,
22−-- leading an instance to count as non-exported:
23−-- * Constraints
24−-- * The type class itself
25−-- * The instance types
26−
27−-- Case 1: constraints
28−instance nonExportedFoo :: (NonexportedClass a) => Foo a where
29− foo = notExported
30−
31−-- Another instance of case 1:
32−instance nonExportedFoo2 :: (Foo NonexportedType) => Foo (a -> a) where
33− foo = id
34−
35−-- Case 2: type class
36−instance nonExportedNonexportedType :: NonexportedClass (Const Number a) where
37− notExported = Const 0
38−
39−-- Case 3: instance types
40−instance constFoo :: Foo (Const NonexportedType b) where
41− foo = Const NonexportedType
examples/manual/passing/Import.pursdeleted−19
@@ -1,19 +0,0 @@
1−module M1 where
2−
3− import Prelude ()
4−
5− id :: forall a. a -> a
6− id = \x -> x
7−
8− foo = id
9−
10−module M2 where
11−
12− import Prelude ()
13− import M1
14−
15− main = \_ -> foo 42
16−
17−module Main where
18−
19−main = Debug.Trace.trace "Done"
examples/manual/passing/ImportExplicit.pursdeleted−14
@@ -1,14 +0,0 @@
1−module M1 where
2−
3− data X = X | Y
4− data Z = Z
5−
6−module Main where
7−
8− import M1 (X(..))
9−
10− testX :: X
11− testX = X
12− testY = Y
13−
14− main = Debug.Trace.trace "Done"
examples/manual/passing/ImportQualified.pursdeleted−12
@@ -1,12 +0,0 @@
1−module M1 where
2−
3− trace x = x
4−
5−module Main where
6−
7− import Prelude
8− import Control.Monad.Eff
9− import M1
10− import qualified Debug.Trace as T
11−
12− main = T.trace (trace "Done")
examples/manual/passing/Module.pursdeleted−28
@@ -1,28 +0,0 @@
1−module M1 where
2−
3− import Prelude
4−
5− data Foo = Foo String
6−
7− foo :: M1.Foo -> String
8− foo = \f -> case f of Foo s -> s ++ "foo"
9−
10− bar :: Foo -> String
11− bar = foo
12−
13− incr :: Number -> Number
14− incr x = x + 1
15−
16−module M2 where
17−
18− import Prelude
19−
20− baz :: M1.Foo -> String
21− baz = M1.foo
22−
23− match :: M1.Foo -> String
24− match = \f -> case f of M1.Foo s -> s ++ "foo"
25−
26−module Main where
27−
28−main = Debug.Trace.trace "Done"
examples/manual/passing/ModuleDeps.pursdeleted−17
@@ -1,17 +0,0 @@
1−module M1 where
2−
3−import M2
4−
5−foo = M3.baz
6−
7−module M2 where
8−
9−bar = M3.baz
10−
11−module M3 where
12−
13−baz = 1
14−
15−module Main where
16−
17−main = Debug.Trace.trace "Done"
examples/manual/passing/RedefinedFixity.pursdeleted−24
@@ -1,24 +0,0 @@
1−module M1 where
2−
3−import Prelude ()
4−
5−($) f a = f a
6−
7−infixr 1000 $
8−
9−module M2 where
10−
11−import Prelude ()
12−
13−import M1
14−
15−module M3 where
16−
17−import Prelude ()
18−
19−import M1
20−import M2
21−
22−module Main where
23−
24−main = Debug.Trace.trace "Done"
examples/manual/passing/ShadowedName.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Debug.Trace
5−
6−done :: String
7−done = let str = "Not yet done" in
8− let str = "Done" in str
9−
10−main = Debug.Trace.trace done
examples/manual/passing/TransitiveImport.pursdeleted−21
@@ -1,21 +0,0 @@
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/manual/passing/WildcardType.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Debug.Trace
5−
6−f1 :: (_ -> _) -> _
7−f1 g = g 1
8−
9−f2 :: _ -> _
10−f2 _ = "Done"
11−
12−main = Debug.Trace.trace $ f1 f2
13−
examples/passing/652.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−class Foo a b
4−
5−class Bar a c
6−
7−class (Foo a b, Bar a c) <= Baz a b c
8−
9−instance foo :: Foo (a -> b) a
10−
11−instance bar :: Bar (a -> b) b
12−
13−instance baz :: (Eq a) => Baz (a -> b) a b
14−
15−main = Debug.Trace.trace "Done"
examples/passing/810.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−data Maybe a = Nothing | Just a
4−
5−test :: forall a. Maybe a -> Maybe a
6−test m = o.x
7− where
8− o = case m of Nothing -> { x : Nothing }
9− Just a -> { x : Just a }
10−
11−main = Debug.Trace.trace "Done"
examples/passing/Applicative.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−import Prelude ()
4−
5−class Applicative f where
6− pure :: forall a. a -> f a
7− (<*>) :: forall a b. f (a -> b) -> f a -> f b
8−
9−data Maybe a = Nothing | Just a
10−
11−instance applicativeMaybe :: Applicative Maybe where
12− pure = Just
13− (<*>) (Just f) (Just a) = Just (f a)
14− (<*>) _ _ = Nothing
15−
16−main = Debug.Trace.trace "Done"
examples/passing/ArrayType.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−class Pointed p where
4− point :: forall a. a -> p a
5−
6−instance pointedArray :: Pointed Array where
7− point a = [a]
8−
9−main = Debug.Trace.trace "Done"
examples/passing/Auto.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3− data Auto s i o = Auto { state :: s, step :: s -> i -> o }
4−
5− type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r
6−
7− exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o
8− exists = \state step f -> f (Auto { state: state, step: step })
9−
10− run :: forall i o. SomeAuto i o -> i -> o
11− run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)
12−
13− main = Debug.Trace.trace "Done"
examples/passing/AutoPrelude.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−
5−f x = x * 10.0
6−g y = y - 10.0
7−
8−main = trace $ show $ (f <<< g) 100.0
examples/passing/AutoPrelude2.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import qualified Prelude as P
4−import Debug.Trace
5−
6−f :: forall a. a -> a
7−f = P.id
8−
9−main = P.($) trace ((f P.<<< f) "Done")
examples/passing/BindersInFunctions.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−snd = \[_, y] -> y
6−
7−foreign import error
8− """
9− function error(msg) {
10− throw msg;
11− }
12− """ :: forall a. String -> a
13−
14−main =
15− let ts = snd [1.0, 2.0] in
16− if ts == 2.0
17− then Debug.Trace.trace "Done"
18− else error "Incorrect result from 'snd'."
examples/passing/BindingGroups.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−foo = bar
4− where bar r = r + 1.0
5−
6−r = foo 2.0
7−
8−main = Debug.Trace.trace "Done"
examples/passing/BlockString.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−foreign import foo """
4− function foo(s) {
5− return s;
6− }
7−""" :: String -> String
8−
9−bar :: String -> String
10−bar _ = foo "test"
11−
12−main = Debug.Trace.trace "Done"
examples/passing/CaseInDo.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−import Control.Monad.Eff
5−
6−foreign import doIt "function doIt() { global.flag = true; }" :: forall eff. Eff eff Unit
7−
8−foreign import get "function get() { return global.flag; }" :: forall eff. Eff eff Boolean
9−
10−set = do
11− trace "Testing..."
12− case 0 of
13− 0 -> doIt
14− _ -> return unit
15−
16−main = do
17− set
18− b <- get
19− case b of
20− true -> trace "Done"
examples/passing/CaseStatement.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−data A = A | B | C
4−
5−f a _ A = a
6−f _ a B = a
7−f _ _ C = "Done"
8−
9−g a _ A = a
10−g _ b B = b
11−g _ _ C = C
12−
13−data M a = N | J a
14−
15−h f N a = a
16−h f a N = a
17−h f (J a) (J b) = J (f a b)
18−
19−main = Debug.Trace.trace $ f "Done" "Failed" A
examples/passing/CheckFunction.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3−test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0
4−
5−main = Debug.Trace.trace "Done"
examples/passing/CheckSynonymBug.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− type Foo a = Array a
6−
7− foreign import length
8− """
9− function length(a) {
10− return a.length;
11− }
12− """ :: forall a. Array a -> Number
13−
14− foo _ = length ([] :: Foo Number)
15−
16− main = Debug.Trace.trace "Done"
examples/passing/CheckTypeClass.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3− data Bar a = Bar
4− data Baz
5−
6− class Foo a where
7− foo :: Bar a -> Baz
8−
9− foo_ :: forall a. (Foo a) => a -> Baz
10− foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)
11−
12− mkBar :: forall a. a -> Bar a
13− mkBar _ = Bar
14−
15− main = Debug.Trace.trace "Done"
16−
examples/passing/Church.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3− import Prelude ()
4−
5− type List a = forall r. r -> (a -> r -> r) -> r
6−
7− empty :: forall a. List a
8− empty = \r f -> r
9−
10− cons :: forall a. a -> List a -> List a
11− cons = \a l r f -> f a (l r f)
12−
13− append :: forall a. List a -> List a -> List a
14− append = \l1 l2 r f -> l2 (l1 r f) f
15−
16− test = append (cons 1 empty) (cons 2 empty)
17−
18− main = Debug.Trace.trace "Done"
examples/passing/Collatz.pursdeleted−29
@@ -1,29 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Control.Monad.ST
5−
6−foreign import jsMod
7− """
8− function jsMod(x) {
9− return function (y) {
10− return x % y;
11− };
12− }
13− """ :: Number -> Number -> Number
14−
15−infixl 7 %
16−(%) = jsMod
17−
18−collatz :: Number -> Number
19−collatz n = runPure (runST (do
20− r <- newSTRef n
21− count <- newSTRef 0.0
22− untilE $ do
23− modifySTRef count $ (+) 1.0
24− m <- readSTRef r
25− writeSTRef r $ if m % 2.0 == 0.0 then m / 2.0 else 3.0 * m + 1.0
26− return $ m == 1.0
27− readSTRef count))
28−
29−main = Debug.Trace.print $ collatz 1000.0
examples/passing/Comparisons.pursdeleted−25
@@ -1,25 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Debug.Trace
5−
6−foreign import data Assert :: !
7−
8−foreign import assert
9− """
10− function assert(x) {
11− return function() {
12− if (!x) throw new Error('assertion failed');
13− return {};
14− };
15− }
16− """ :: forall e. Boolean -> Eff (assert :: Assert | e) Unit
17−
18−main = do
19− assert (1.0 < 2.0)
20− assert (2.0 == 2.0)
21− assert (3.0 > 1.0)
22− assert ("a" < "b")
23− assert ("a" == "a")
24− assert ("z" > "a")
25− trace "Done!"
examples/passing/Conditional.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3− import Prelude ()
4−
5− fns = \f -> if f true then f else \x -> x
6−
7− not = \x -> if x then false else true
8−
9− main = Debug.Trace.trace "Done"
examples/passing/Console.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Debug.Trace
6−
7−replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {}
8−replicateM_ 0.0 _ = return {}
9−replicateM_ n act = do
10− act
11− replicateM_ (n - 1.0) act
12−
13−main = replicateM_ 10.0 (trace "Hello World!")
examples/passing/DataAndType.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−data A = A B
4−
5−type B = A
6−
7−main = Debug.Trace.trace "Done"
examples/passing/DeepArrayBinder.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−
5−data List a = Cons a (List a) | Nil
6−
7−match2 :: List Number -> Number
8−match2 (Cons x (Cons y xs)) = x * y + match2 xs
9−match2 _ = 0.0
10−
11−foreign import explode
12− """
13− function explode() {
14− throw new Error('Incorrect result');
15− }
16− """ :: forall eff a. Eff eff a
17−
18−main = case match2 (Cons 1.0 (Cons 2.0 (Cons 3.0 (Cons 4.0 (Cons 5.0 (Cons 6.0 (Cons 7.0 (Cons 8.0 (Cons 9.0 Nil))))))))) of
19− 100.0 -> Debug.Trace.trace "Done"
20− _ -> explode
examples/passing/DeepCase.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−
7−f x y =
8− let
9− g = case y of
10− 0.0 -> x
11− x -> 1.0 + x * x
12− in g + x + y
13−
14−main = print $ f 1.0 10.0
examples/passing/Do.pursdeleted−67
@@ -1,67 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Maybe a = Nothing | Just a
6−
7−instance functorMaybe :: Functor Maybe where
8− (<$>) f Nothing = Nothing
9− (<$>) f (Just x) = Just (f x)
10−
11−instance applyMaybe :: Apply Maybe where
12− (<*>) (Just f) (Just x) = Just (f x)
13− (<*>) _ _ = Nothing
14−
15−instance applicativeMaybe :: Applicative Maybe where
16− pure = Just
17−
18−instance bindMaybe :: Bind Maybe where
19− (>>=) Nothing _ = Nothing
20− (>>=) (Just a) f = f a
21−
22−instance monadMaybe :: Prelude.Monad Maybe
23−
24−test1 = \_ -> do
25− Just "abc"
26−
27−test2 = \_ -> do
28− x <- Just 1.0
29− y <- Just 2.0
30− Just (x + y)
31−
32−test3 = \_ -> do
33− Just 1.0
34− Nothing :: Maybe Number
35− Just 2.0
36−
37−test4 mx my = do
38− x <- mx
39− y <- my
40− Just (x + y + 1.0)
41−
42−test5 mx my mz = do
43− x <- mx
44− y <- my
45− let sum = x + y
46− z <- mz
47− Just (z + sum + 1.0)
48−
49−test6 mx = \_ -> do
50− let
51− f :: forall a. Maybe a -> a
52− f (Just x) = x
53− Just (f mx)
54−
55−test8 = \_ -> do
56− Just (do
57− Just 1.0)
58−
59−test9 = \_ -> (+) <$> Just 1.0 <*> Just 2.0
60−
61−test10 _ = do
62− let
63− f x = g x * 3.0
64− g x = f x / 2.0
65− Just (f 10.0)
66−
67−main = Debug.Trace.trace "Done"
examples/passing/Dollar.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−import Prelude ()
4−
5−($) :: forall a b. (a -> b) -> a -> b
6−($) f x = f x
7−
8−infixr 1000 $
9−
10−id x = x
11−
12−test1 x = id $ id $ id $ id $ x
13−
14−test2 x = id id $ id x
15−
16−main = Debug.Trace.trace "Done"
examples/passing/Eff.pursdeleted−25
@@ -1,25 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−import Debug.Trace
7−
8−test1 = do
9− trace "Line 1"
10− trace "Line 2"
11−
12−test2 = runPure (runST (do
13− ref <- newSTRef 0.0
14− modifySTRef ref $ \n -> n + 1.0
15− readSTRef ref))
16−
17−test3 = pureST (do
18− ref <- newSTRef 0.0
19− modifySTRef ref $ \n -> n + 1.0
20− readSTRef ref)
21−
22−main = do
23− test1
24− Debug.Trace.print test2
25− Debug.Trace.print test3
examples/passing/EmptyDataDecls.pursdeleted−34
@@ -1,34 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Z
6−data S n
7−
8−data ArrayBox n a = ArrayBox (Array a)
9−
10−nil :: forall a. ArrayBox Z a
11−nil = ArrayBox []
12−
13−foreign import concat
14− """
15− function concat(l1) {
16− return function(l2) {
17− return l1.concat(l2);
18− };
19− }
20− """ :: forall a. Array a -> Array a -> Array a
21−
22−cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
23−cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs
24−
25−foreign import error
26− """
27− function error(msg) {
28− throw msg;
29− }
30− """ :: forall a. String -> a
31−
32−main = case cons' 1 $ cons' 2 $ cons' 3 nil of
33− ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"
34− _ -> error "Failed"
examples/passing/EmptyRow.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−data Foo r = Foo { | r }
4−
5−test :: Foo ()
6−test = Foo {}
7−
8−main = Debug.Trace.trace "Done"
examples/passing/EmptyTypeClass.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class Partial
6−
7−head :: forall a. (Partial) => Array a -> a
8−head [x] = x
9−
10−instance allowPartials :: Partial
11−
12−main = Debug.Trace.trace $ head ["Done"]
examples/passing/EqOrd.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−data Pair a b = Pair a b
4−
5−instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
6− compare (Pair a1 b1) (Pair a2 b2) = case compare a1 a2 of
7− EQ -> compare b1 b2
8− r -> r
9−
10−instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
11− (==) (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2
12− (/=) (Pair a1 b1) (Pair a2 b2) = a1 /= a2 || b1 /= b2
13−
14−main = Debug.Trace.print $ Pair 1.0 2.0 == Pair 1.0 2.0
examples/passing/ExtendedInfixOperators.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering
4−comparing f = compare `Data.Function.on` f
5−
6−null [] = true
7−null _ = false
8−
9−test = [1.0, 2.0, 3.0] `comparing null` [4.0, 5.0, 6.0]
10−
11−main = do
12− Debug.Trace.print test
examples/passing/ExternData.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3− foreign import data IO :: * -> *
4−
5− foreign import bind "function bind() {}" :: forall a b. IO a -> (a -> IO b) -> IO b
6−
7− foreign import showMessage "function showMessage() {}" :: String -> IO { }
8−
9− foreign import prompt "function prompt() {}" :: IO String
10−
11− test _ = prompt `bind` \s -> showMessage s
12−
13− main = Debug.Trace.trace "Done"
examples/passing/ExternRaw.pursdeleted−26
@@ -1,26 +0,0 @@
1−module Main where
2−
3−foreign import first
4− """
5− function first(xs) {
6− return xs[0];
7− }
8− """ :: forall a. Array a -> a
9−
10−foreign import loop
11− """
12− function loop() {
13− while (true) {}
14− }
15− """ :: forall a. a
16−
17−foreign import concat
18− """
19− function concat(xs) {
20− return function(ys) {
21− return xs.concat(ys);
22− };
23− }
24− """ :: forall a. Array a -> Array a -> Array a
25−
26−main = Debug.Trace.trace "Done"
examples/passing/FFI.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−foreign import foo
4− """
5− function foo(s) {
6− return s;
7− }
8− """ :: String -> String
9−
10−bar :: String -> String
11−bar _ = foo "test"
12−
13−main = Debug.Trace.trace "Done"
examples/passing/Fib.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−
7−main = runST (do
8− n1 <- newSTRef 1.0
9− n2 <- newSTRef 1.0
10− whileE ((>) 1000.0 <$> readSTRef n1) $ do
11− n1' <- readSTRef n1
12− n2' <- readSTRef n2
13− writeSTRef n2 $ n1' + n2'
14− writeSTRef n1 n2'
15− Debug.Trace.print n2')
examples/passing/FinalTagless.pursdeleted−22
@@ -1,22 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class E e where
6− num :: Number -> e Number
7− add :: e Number -> e Number -> e Number
8−
9−type Expr a = forall e. (E e) => e a
10−
11−data Id a = Id a
12−
13−instance exprId :: E Id where
14− num = Id
15− add (Id n) (Id m) = Id (n + m)
16−
17−runId (Id a) = a
18−
19−three :: Expr Number
20−three = add (num 1.0) (num 2.0)
21−
22−main = Debug.Trace.print $ runId three
examples/passing/ForeignInstance.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−class Foo a where
4− foo :: a -> String
5−
6−foreign import instance fooArray :: (Foo a) => Foo (Array a)
7−
8−foreign import instance fooNumber :: Foo Number
9−
10−foreign import instance fooString :: Foo String
11−
12−foreign import fooString "var fooString = {};" :: Unit
13−foreign import fooNumber "var fooNumber = {};" :: Unit
14−foreign import fooArray "var fooArray = {};" :: Unit
15−
16−test1 _ = foo [1.0, 2.0, 3.0]
17−
18−test2 _ = foo "Test"
19−
20−main = Debug.Trace.trace "Done"
examples/passing/FunctionScope.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− mkValue :: Number -> Number
6− mkValue id = id
7−
8− foreign import error
9− """
10− function error(msg) {
11− throw msg;
12− }
13− """ :: forall a. String -> a
14−
15− main = do
16− let value = mkValue 1.0
17− if value == 1.0
18− then Debug.Trace.trace "Done"
19− else error "Not done"
examples/passing/Functions.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− test1 = \_ -> 0.0
6−
7− test2 = \a b -> a + b + 1.0
8−
9− test3 = \a -> a
10−
11− test4 = \(%%) -> 1.0 %% 2.0
12−
13− test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0
14−
15− main = Debug.Trace.trace "Done"
examples/passing/Functions2.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− test :: forall a b. a -> b -> a
6− test = \const _ -> const
7−
8− foreign import error
9− """
10− function error(msg) {
11− throw msg;
12− }
13− """ :: forall a. String -> a
14−
15− main = do
16− let value = test "Done" {}
17− if value == "Done"
18− then Debug.Trace.trace "Done"
19− else error "Not done"
examples/passing/Guards.pursdeleted−39
@@ -1,39 +0,0 @@
1−module Main where
2−
3−foreign import jsMod
4− """
5− function jsMod(x) {
6− return function (y) {
7− return x % y;
8− };
9− }
10− """ :: Number -> Number -> Number
11−
12−infixl 7 %
13−(%) = jsMod
14−
15−collatz = \x -> case x of
16− y | y % 2.0 == 0.0 -> y / 2.0
17− y -> y * 3.0 + 1.0
18−
19−-- Guards have access to current scope
20−collatz2 = \x y -> case x of
21− z | y > 0.0 -> z / 2.0
22− z -> z * 3.0 + 1.0
23−
24−min :: forall a. (Ord a) => a -> a -> a
25−min n m | n < m = n
26− | otherwise = m
27−
28−max :: forall a. (Ord a) => a -> a -> a
29−max n m = case unit of
30− _ | m < n -> n
31− | otherwise -> m
32−
33−testIndentation :: Number -> Number -> Number
34−testIndentation x y | x > 0.0
35− = x + y
36− | otherwise
37− = y - x
38−
39−main = Debug.Trace.trace $ min "Done" "ZZZZ"
examples/passing/HoistError.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Debug.Trace
5−
6−foreign import f
7− """
8− function f(x) {
9− return function() {
10− if (x !== 0) throw new Error('x is not 0');
11− };
12− }
13− """ :: forall e. Number -> Eff e Number
14−
15−main = do
16− let x = 0.0
17− f x
18− let x = 1.0 + 1.0
19− trace "Done"
examples/passing/IfThenElseMaybe.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−data Maybe a = Nothing | Just a
4−
5−test1 = if true then Just 10 else Nothing
6−
7−test2 = if true then Nothing else Just 10
8−
9−main = Debug.Trace.trace "Done"
examples/passing/ImplicitEmptyImport.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−main = do
4− Debug.Trace.trace "Hello"
5− Debug.Trace.trace "Goodbye"
6− Debug.Trace.trace "Done"
examples/passing/ImportHiding.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−import Prelude hiding (
5− show, -- a value
6− Show, -- a type class
7− Unit(..) -- a constructor
8− )
9−
10−show = 1.0
11−
12−class Show a where
13− noshow :: a -> a
14−
15−data Unit = X | Y
16−
17−main = do
18− print show
examples/passing/InferRecFunWithConstrainedArgument.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−test 100.0 = 100.0
6−test n = test(1.0 + n)
7−
8−main = Debug.Trace.print $ test 0.0
examples/passing/InstanceBeforeClass.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−instance fooNumber :: Foo Number where
4− foo = 0.0
5−
6−class Foo a where
7− foo :: a
8−
9−main = Debug.Trace.trace "Done"
examples/passing/IntAndChar.pursdeleted−25
@@ -1,25 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−
5−f 1 = 1
6−f _ = 0
7−
8−g 'a' = 'a'
9−g _ = 'b'
10−
11−foreign import assertEqual
12− """
13− function assertEqual(a) { return function(b) { return function() {
14− if (a != b) {
15− throw new Error('Assertion failed!');
16− }
17− }; }; }
18− """ :: forall eff a. a -> a -> Eff eff Unit
19−
20−main = do
21− assertEqual (f 1) 1
22− assertEqual (f 0) 0
23− assertEqual (g 'a') 'a'
24− assertEqual (g 'b') 'b'
25− Debug.Trace.trace "Done"
examples/passing/JSReserved.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− yield = 0
6− member = 1
7−
8− public = \return -> return
9−
10− this catch = catch
11−
12− main = Debug.Trace.trace "Done"
examples/passing/KindedType.pursdeleted−31
@@ -1,31 +0,0 @@
1−module Main where
2−
3−type Star2Star f = f :: * -> *
4−
5−type Star t = t :: *
6−
7−test1 :: Star2Star Array String
8−test1 = ["test"]
9−
10−f :: Star (String -> String)
11−f s = s
12−
13−test2 = f "test"
14−
15−data Proxy (f :: * -> *) = Proxy
16−
17−test3 :: Proxy Array
18−test3 = Proxy
19−
20−type Test (f :: * -> *) = f String
21−
22−test4 :: Test Array
23−test4 = ["test"]
24−
25−class Clazz (a :: *) where
26− def :: a
27−
28−instance clazzString :: Clazz String where
29− def = "test"
30−
31−main = Debug.Trace.trace "Done"
examples/passing/Let.pursdeleted−53
@@ -1,53 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−
7−test1 x = let
8− y :: Number
9− y = x + 1.0
10− in y
11−
12−test2 x y =
13− let x' = x + 1.0 in
14− let y' = y + 1.0 in
15− x' + y'
16−
17−test3 = let f x y z = x + y + z in
18− f 1.0 2.0 3.0
19−
20−test4 = let f x [y, z] = x y z in
21− f (+) [1.0, 2.0]
22−
23−test5 = let
24− f x | x > 0.0 = g (x / 2.0) + 1.0
25− f x = 0.0
26− g x = f (x - 1.0) + 1.0
27− in f 10.0
28−
29−test7 = let
30− f :: forall a. a -> a
31− f x = x
32− in if f true then f 1.0 else f 2.0
33−
34−test8 :: Number -> Number
35−test8 x = let
36− go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
37− go y = go $ (y + x / y) / 2.0
38− in go x
39−
40−test10 _ =
41− let
42− f x = g x * 3.0
43− g x = f x / 2.0
44− in f 10.0
45−
46−main = do
47− Debug.Trace.print (test1 1.0)
48− Debug.Trace.print (test2 1.0 2.0)
49− Debug.Trace.print test3
50− Debug.Trace.print test4
51− Debug.Trace.print test5
52− Debug.Trace.print test7
53− Debug.Trace.print (test8 100.0)
examples/passing/Let2.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−test =
4− let f :: Number -> Boolean
5− f 0.0 = false
6− f n = g (n - 1.0)
7−
8− g :: Number -> Boolean
9− g 0.0 = true
10− g n = f (n - 1.0)
11−
12− x = f 1.0
13− in not x
14−
15−main = Debug.Trace.print test
examples/passing/LetInInstance.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−class Foo a where
4− foo :: a -> String
5−
6−instance fooString :: Foo String where
7− foo = go
8− where
9− go :: String -> String
10− go s = s
11−
12−main = Debug.Trace.trace "Done"
examples/passing/LiberalTypeSynonyms.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−type Reader = (->) String
4−
5−foo :: Reader String
6−foo s = s
7−
8−type AndFoo r = (foo :: String | r)
9−
10−getFoo :: forall r. Prim.Object (AndFoo r) -> String
11−getFoo o = o.foo
12−
13−type F r = { | r } -> { | r }
14−
15−f :: (forall r. F r) -> String
16−f g = case g { x: "Hello" } of
17− { x = x } -> x
18−
19−main = Debug.Trace.trace "Done"
examples/passing/MPTCs.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class NullaryTypeClass where
6− greeting :: String
7−
8−instance nullaryTypeClass :: NullaryTypeClass where
9− greeting = "Hello, World!"
10−
11−class Coerce a b where
12− coerce :: a -> b
13−
14−instance coerceRefl :: Coerce a a where
15− coerce a = a
16−
17−instance coerceShow :: (Prelude.Show a) => Coerce a String where
18− coerce = show
19−
20−main = Debug.Trace.trace "Done"
examples/passing/Match.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3− data Foo a = Foo
4−
5− foo = \f -> case f of Foo -> "foo"
6−
7− main = Debug.Trace.trace "Done"
examples/passing/Monad.pursdeleted−32
@@ -1,32 +0,0 @@
1−module Main where
2−
3− import Prelude ()
4−
5− type Monad m = { return :: forall a. a -> m a
6− , bind :: forall a b. m a -> (a -> m b) -> m b }
7−
8− data Id a = Id a
9−
10− id :: Monad Id
11− id = { return : Id
12− , bind : \ma f -> case ma of Id a -> f a }
13−
14− data Maybe a = Nothing | Just a
15−
16− maybe :: Monad Maybe
17− maybe = { return : Just
18− , bind : \ma f -> case ma of
19− Nothing -> Nothing
20− Just a -> f a
21− }
22−
23− test :: forall m. Monad m -> m Number
24− test = \m -> m.bind (m.return 1.0) (\n1 ->
25− m.bind (m.return "Test") (\n2 ->
26− m.return n1))
27−
28− test1 = test id
29−
30− test2 = test maybe
31−
32− main = Debug.Trace.trace "Done"
examples/passing/MonadState.pursdeleted−48
@@ -1,48 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Tuple a b = Tuple a b
6−
7−class MonadState s m where
8− get :: m s
9− put :: s -> m {}
10−
11−data State s a = State (s -> Tuple s a)
12−
13−runState s (State f) = f s
14−
15−instance functorState :: Functor (State s) where
16− (<$>) = liftM1
17−
18−instance applyState :: Apply (State s) where
19− (<*>) = ap
20−
21−instance applicativeState :: Applicative (State s) where
22− pure a = State $ \s -> Tuple s a
23−
24−instance bindState :: Bind (State s) where
25− (>>=) f g = State $ \s -> case runState s f of
26− Tuple s1 a -> runState s1 (g a)
27−
28−instance monadState :: Monad (State s)
29−
30−instance monadStateState :: MonadState s (State s) where
31− get = State (\s -> Tuple s s)
32− put s = State (\_ -> Tuple s {})
33−
34−modify :: forall m s. (Prelude.Monad m, MonadState s m) => (s -> s) -> m {}
35−modify f = do
36− s <- get
37− put (f s)
38−
39−test :: Tuple String String
40−test = runState "" $ do
41− modify $ (++) "World!"
42− modify $ (++) "Hello, "
43− get
44−
45−main = do
46− let t1 = test
47− Debug.Trace.trace "Done"
48−
examples/passing/MultiArgFunctions.pursdeleted−26
@@ -1,26 +0,0 @@
1−module Main where
2−
3−import Data.Function
4−import Control.Monad.Eff
5−import Debug.Trace
6−
7−f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a
8−
9−g = mkFn2 $ \a b -> case {} of
10− _ | a <= 0.0 || b <= 0.0 -> b
11− _ -> runFn2 f (a - 0.0) (b - 0.0)
12−
13−main = do
14− runFn0 (mkFn0 $ \_ -> trace $ show 0.0)
15− runFn1 (mkFn1 $ \a -> trace $ show a) 0.0
16− runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 0.0 0.0
17− runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 0.0 0.0 0.0
18− runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 0.0 0.0 0.0 0.0
19− runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 0.0 0.0 0.0 0.0 0.0
20− runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 0.0 0.0 0.0 0.0 0.0 0.0
21− runFn7 (mkFn7 $ \a b c d e f g -> trace $ show [a, b, c, d, e, f, g]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0
22− runFn8 (mkFn8 $ \a b c d e f g h -> trace $ show [a, b, c, d, e, f, g, h]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
23− runFn9 (mkFn9 $ \a b c d e f g h i -> trace $ show [a, b, c, d, e, f, g, h, i]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
24− runFn10 (mkFn10 $ \a b c d e f g h i j-> trace $ show [a, b, c, d, e, f, g, h, i, j]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
25− print $ runFn2 g 0.0 0.0
26− trace "Done!"
examples/passing/MutRec.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− f 0.0 = 0.0
6− f x = g x + 0.0
7−
8− g x = f (x / 0.0)
9−
10− data Even = Zero | Even Odd
11−
12− data Odd = Odd Even
13−
14− evenToNumber Zero = 0.0
15− evenToNumber (Even n) = oddToNumber n + 0.0
16−
17− oddToNumber (Odd n) = evenToNumber n + 0.0
18−
19− main = Debug.Trace.trace "Done"
examples/passing/MutRec2.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−data A = A B
4−
5−data B = B A
6−
7−foreign import data S :: *
8−
9−f :: A -> S
10−f a = case a of A b -> g b
11−
12−g b = case b of B a -> f a
13−
14−showN :: A -> S
15−showN a = f a
16−
17−main = Debug.Trace.trace "Done"
examples/passing/MutRec3.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−data A = A B
4−
5−data B = B A
6−
7−foreign import data S :: *
8−
9−f a = case a of A b -> g b
10−
11−g :: B -> S
12−g b = case b of B a -> f a
13−
14−showN :: A -> S
15−showN a = f a
16−
17−main = Debug.Trace.trace "Done"
examples/passing/NamedPatterns.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3− foo = \x -> case x of
4− y@{ foo = "Foo" } -> y
5− y -> y
6−
7− main = Debug.Trace.trace "Done"
examples/passing/NegativeBinder.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−test :: Number -> Boolean
4−test -1.0 = false
5−test _ = true
6−
7−main = Debug.Trace.trace "Done"
examples/passing/Nested.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3− data Extend r a = Extend { prev :: r a, next :: a }
4−
5− data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)
6−
7− main = Debug.Trace.trace "Done"
examples/passing/NestedTypeSynonyms.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− type X = String
6− type Y = X -> X
7−
8− fn :: Y
9− fn a = a
10−
11− main = Debug.Trace.print (fn "Done")
examples/passing/NestedWhere.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−f x = g x
4− where
5− g x = go x
6− where
7− go x = go1 (x - 1.0)
8− go1 x = go x
9−
10−main = Debug.Trace.trace "Done"
examples/passing/Newtype.pursdeleted−22
@@ -1,22 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Debug.Trace
5−
6−newtype Thing = Thing String
7−
8−instance showThing :: Show Thing where
9− show (Thing x) = "Thing " ++ show x
10−
11−newtype Box a = Box a
12−
13−instance showBox :: (Show a) => Show (Box a) where
14− show (Box x) = "Box " ++ show x
15−
16−apply f x = f x
17−
18−main = do
19− print $ Thing "hello"
20− print $ Box 42.0
21− print $ apply Box 9000.0
22− trace "Done"
examples/passing/NewtypeEff.pursdeleted−28
@@ -1,28 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−import Control.Monad.Eff
5−
6−newtype T a = T (Eff (trace :: Trace) a)
7−
8−runT :: forall a. T a -> Eff (trace :: Trace) a
9−runT (T t) = t
10−
11−instance functorT :: Functor T where
12− (<$>) f (T t) = T (f <$> t)
13−
14−instance applyT :: Apply T where
15− (<*>) (T f) (T x) = T (f <*> x)
16−
17−instance applicativeT :: Applicative T where
18− pure t = T (pure t)
19−
20−instance bindT :: Bind T where
21− (>>=) (T t) f = T (t >>= \x -> runT (f x))
22−
23−instance monadT :: Monad T
24−
25−main = runT do
26− T $ trace "Done"
27− T $ trace "Done"
28− T $ trace "Done"
examples/passing/NewtypeWithRecordUpdate.pursdeleted−15
@@ -1,15 +0,0 @@
1−-- https://github.com/purescript/purescript/issues/812.0
2−
3−module Main where
4−
5−import Debug.Trace
6−
7−newtype NewType a = NewType (Object a)
8−
9−rec1 :: Object (a :: Number, b :: Number, c:: Number)
10−rec1 = { a: 0.0, b: 0.0, c: 0.0 }
11−
12−rec2 :: NewType (a :: Number, b :: Number, c :: Number)
13−rec2 = NewType (rec1 { a = 1.0 })
14−
15−main = trace "Done"
examples/passing/ObjectGetter.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−getX = _.x
4−
5−point = { x: 1.0, y: 0.0 }
6−
7−main = do
8− Debug.Trace.print $ getX point
9− Debug.Trace.trace $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }
10− Debug.Trace.trace $ (_.x >>> _.y) { x: { y: "Nested" } }
11− Debug.Trace.trace $ _.value { value: "Done!" }
examples/passing/ObjectSynonym.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−type Inner = Number
4−
5−inner :: Inner
6−inner = 0.0
7−
8−type Outer = { inner :: Inner }
9−
10−outer :: Outer
11−outer = { inner: inner }
12−
13−main = Debug.Trace.trace "Done"
examples/passing/ObjectUpdate.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3− update1 = \o -> o { foo = "Foo" }
4−
5− update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
6− update2 = \o -> o { foo = "Foo" }
7−
8− replace = \o -> case o of
9− { foo = "Foo" } -> o { foo = "Bar" }
10− { foo = "Bar" } -> o { bar = "Baz" }
11− o -> o
12−
13− polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
14− polyUpdate = \o -> o { foo = "Foo" }
15−
16− inferPolyUpdate = \o -> o { foo = "Foo" }
17−
18− main = Debug.Trace.trace ((update1 {foo: ""}).foo)
examples/passing/ObjectUpdate2.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−type X r = { | r }
4−
5−foreign import x "var x = {};" :: forall r. X r
6−
7−blah :: forall r. X r -> X r
8−blah x = x
9−
10−test = blah x
11− { baz = "blah"
12− }
13−
14−main = Debug.Trace.trace "Done"
examples/passing/ObjectUpdater.pursdeleted−35
@@ -1,35 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Debug.Trace
5−
6−foreign import eqeqeq
7− """
8− function eqeqeq(x) {
9− return function (y) {
10− if (x == y) return x;
11− throw new Error("Unexpected result: " + x + " /== " + y);
12− };
13− };
14− """ :: forall a. a -> a -> a
15−
16−(===) = eqeqeq
17−infixl 4 ===
18−
19−getValue :: forall e. Eff (| e) Boolean
20−getValue = return true
21−
22−main = do
23− let record = { value: false }
24− record' <- record { value = _ } <$> getValue
25− print $ record'.value === true
26−
27− let point = { x: 1.0, y: 1.0 }
28− x = 10.0
29− point' = (point { x = _, y = x }) 100.0
30−
31− print $ point'.x === 100.0
32− print $ point'.y === 10.0
33−
34− let record2 = (_ { x = _ }) { x: 0.0 } 10.0
35− print $ record2.x === 10.0
examples/passing/ObjectWildcards.pursdeleted−31
@@ -1,31 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Debug.Trace
5−
6−mkRecord = { foo: _, bar: _, baz: "baz" }
7−
8−getValue :: forall e. Eff (| e) Boolean
9−getValue = return true
10−
11−foreign import eqeqeq
12− """
13− function eqeqeq(x) {
14− return function (y) {
15− if (x == y) return x;
16− throw new Error("Unexpected result: " + x + " /== " + y);
17− };
18− };
19− """ :: forall a. a -> a -> a
20−
21−(===) = eqeqeq
22−infixl 4 ===
23−
24−main = do
25− obj <- { value: _ } <$> getValue
26− print obj.value
27− let x = 1.0
28− point <- { x: _, y: x } <$> return 2.0
29− print $ point.x === 2.0
30− print $ point.y === 1.0
31− trace (mkRecord 1.0 "Done!").bar
examples/passing/Objects.pursdeleted−35
@@ -1,35 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− test = \x -> x.foo + x.bar + 1.0
6−
7− append = \o -> { foo: o.foo, bar: 1.0 }
8−
9− apTest = append({foo : "Foo", baz: "Baz"})
10−
11− f = (\a -> a.b.c) { b: { c: 1.0, d: "Hello" }, e: "World" }
12−
13− g = (\a -> a.f { x: 1.0, y: "y" }) { f: \o -> o.x + 1.0 }
14−
15− typed :: { foo :: Number }
16− typed = { foo: 0.0 }
17−
18− test2 = \x -> x."!@#"
19−
20− test3 = typed."foo"
21−
22− test4 = test2 weirdObj
23− where
24− weirdObj :: { "!@#" :: Number }
25− weirdObj = { "!@#": 1.0 }
26−
27− test5 = case { "***": 1.0 } of
28− { "***" = n } -> n
29−
30− test6 = case { "***": 1.0 } of
31− { "***": n } -> n
32−
33− test7 {a: snoog , b : blah } = blah
34−
35− main = Debug.Trace.trace "Done"
examples/passing/OneConstructor.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−data One a = One a
4−
5−one' (One a) = a
6−
7−main = Debug.Trace.trace "Done"
examples/passing/OperatorAssociativity.pursdeleted−50
@@ -1,50 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Debug.Trace
5−
6−foreign import data Assert :: !
7−
8−foreign import assert
9− """
10− function assert(x) {
11− return function(desc) {
12− return function() {
13− if (!x) throw new Error('assertion (' + desc + ') failed');
14− return {};
15− };
16− };
17− }
18− """ :: forall e. Boolean -> String -> Eff (assert :: Assert | e) Unit
19−
20−bug :: Number -> Number -> Number
21−bug a b = 0.0 - (a - b)
22−
23−foreign import explode
24− """
25− function explode() {
26− throw new Error('Assertion failed!');
27− }
28− """ :: forall eff a. Eff eff a
29−
30−main = do
31− assert (bug 0.0 2.0 == 2.0) "bug 0.0 2.0 == 2.0"
32− assert (0.0 - (0.0 - 2.0) == 2.0) "0.0 - (0.0 - 2.0) == 2.0"
33− assert (0.0 - (0.0 + 2.0) == -2.0) "0.0 - (0.0 + 2.0) == -2.0"
34−
35− assert (6.0 / (3.0 * 2.0) == 1.0) "6.0 / (3.0 * 2.0) == 1.0"
36− assert ((6.0 / 3.0) * 2.0 == 4.0) "(6.0 / 3.0) * 2.0 == 4.0"
37−
38− assert (not (1.0 < 0.0) == true) "not (1.0 < 0.0) == true"
39− assert (not ((negate 1.0) < 0.0) == false) "not ((negate 1.0) < 0.0) == false"
40−
41− assert (negate (1.0 + 10.0) == -11.0) "negate (1.0 + 10.0) == -11.0"
42−
43− assert (2.0 * 3.0 / 4.0 == 1.5) "2.0 * 3.0 / 4.0 == 1.5"
44− assert (1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0) "1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0"
45−
46− assert (1.0 + 10.0 - 5.0 == 6.0) "1.0 + 10.0 - 5.0 == 6.0"
47− assert (1.0 + 10.0 * 5.0 == 51.0) "1.0 + 10.0 * 5.0 == 51.0"
48− assert (10.0 * 5.0 - 1.0 == 49.0) "10.0 * 5.0 - 1.0 == 49.0"
49−
50− trace "Success!"
examples/passing/OperatorInlining.pursdeleted−46
@@ -1,46 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−
5−main = do
6−
7− -- semiringNumber
8− print (1.0 + 2.0)
9− print (1.0 * 2.0)
10−
11− -- ringNumber
12− print (1.0 - 2.0)
13− print (negate 1.0)
14−
15− -- moduleSemiringNumber
16− print (1.0 / 2.0)
17−
18− -- ordNumber
19− print (1.0 > 2.0)
20− print (1.0 < 2.0)
21− print (1.0 <= 2.0)
22− print (1.0 >= 2.0)
23− print (1.0 == 2.0)
24−
25− -- eqNumber
26− print (1.0 == 2.0)
27− print (1.0 /= 2.0)
28−
29− -- eqString
30− print ("foo" == "bar")
31− print ("foo" /= "bar")
32−
33− -- eqBoolean
34− print (true == false)
35− print (true /= false)
36−
37− -- semigroupString
38− print ("foo" ++ "bar")
39− print ("foo" <> "bar")
40−
41− -- latticeBoolean
42− print (top && true)
43− print (bottom || false)
44−
45− -- complementedLatticeBoolean
46− print (not true)
examples/passing/OperatorSections.pursdeleted−21
@@ -1,21 +0,0 @@
1−module Main where
2−
3−foreign import eqeqeq
4− """
5− function eqeqeq(x) {
6− return function (y) {
7− if (x == y) return x;
8− throw new Error("Unexpected result: " + x + " /== " + y);
9− };
10− };
11− """ :: forall a. a -> a -> a
12−
13−(===) = eqeqeq
14−infixl 4 ===
15−
16−main = do
17− Debug.Trace.print $ (/ 2.0) 4.0 === 2.0
18− Debug.Trace.print $ (2.0 /) 4.0 === 0.5
19− Debug.Trace.print $ (`const` 1.0) 2.0 === 2.0
20− Debug.Trace.print $ (1.0 `const`) 2.0 === 1.0
21− Debug.Trace.trace "Done!"
examples/passing/Operators.pursdeleted−98
@@ -1,98 +0,0 @@
1−module Main where
2−
3− import Control.Monad.Eff
4− import Debug.Trace
5−
6− (?!) :: forall a. a -> a -> a
7− (?!) x _ = x
8−
9− bar :: String -> String -> String
10− bar = \s1 s2 -> s1 ++ s2
11−
12− test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n
13− test1 x y z = x * y + z x y
14−
15− test2 = (\x -> x.foo false) { foo : \_ -> 1.0 }
16−
17− test3 = (\x y -> x)(1.0 + 2.0 * (1.0 + 2.0)) (true && (false || false))
18−
19− k = \x -> \y -> x
20−
21− test4 = 1 `k` 2
22−
23− infixl 5 %%
24−
25− (%%) :: Number -> Number -> Number
26− (%%) x y = x * y + y
27−
28− test5 = 1.0 %% 2.0 %% 3.0
29−
30− test6 = ((\x -> x) `k` 2.0) 3.0
31−
32− (<+>) :: String -> String -> String
33− (<+>) = \s1 s2 -> s1 ++ s2
34−
35− test7 = "Hello" <+> "World!"
36−
37− (@@) :: forall a b. (a -> b) -> a -> b
38− (@@) = \f x -> f x
39−
40− foo :: String -> String
41− foo = \s -> s
42−
43− test8 = foo @@ "Hello World"
44−
45− test9 = Main.foo @@ "Hello World"
46−
47− test10 = "Hello" `Main.bar` "World"
48−
49− (...) :: forall a. Array a -> Array a -> Array a
50− (...) = \as -> \bs -> as
51−
52− test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]
53−
54− test12 (<%>) a b = a <%> b
55−
56− test13 = \(<%>) a b -> a <%> b
57−
58− test14 :: Number -> Number -> Boolean
59− test14 a b = a < b
60−
61− test15 :: Number -> Number -> Boolean
62− test15 a b = const false $ a `test14` b
63−
64− test17 :: Number
65− test17 = negate (-1.0)
66−
67− test18 :: Number
68− test18 = negate $ negate 1.0
69−
70− test19 :: Number
71− test19 = negate $ negate (-1.0)
72−
73− test20 :: Number
74− test20 = 1.0 @ 2.0
75− where
76− (@) x y = x + y * y
77−
78− main = do
79− let t1 = test1 1.0 2.0 (\x y -> x + y)
80− let t2 = test2
81− let t3 = test3
82− let t4 = test4
83− let t5 = test5
84− let t6 = test6
85− let t7 = test7
86− let t8 = test8
87− let t9 = test9
88− let t10 = test10
89− let t11 = test11
90− let t12 = test12 k 1.0 2.0
91− let t13 = test13 k 1.0 2.0
92− let t14 = test14 1.0 2.0
93− let t15 = test15 1.0 2.0
94− let t17 = test17
95− let t18 = test18
96− let t19 = test19
97− let t20 = test20
98− trace "Done"
examples/passing/OptimizerBug.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−x a = 1.0 + y a
6−
7−y a = x a
8−
9−main = Debug.Trace.trace "Done"
examples/passing/PartialFunction.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−foreign import testError
4− """
5− function testError(f) {
6− try {
7− return f();
8− } catch (e) {
9− if (e instanceof Error) return 'success';
10− throw new Error('Pattern match failure is not Error');
11− }
12− }
13− """ :: (Unit -> Number) -> String
14−
15−fn :: Number -> Number
16−fn 0.0 = 0.0
17−fn 1.0 = 2.0
18−
19−main = Debug.Trace.trace (show $ testError $ \_ -> fn 2.0)
examples/passing/Patterns.pursdeleted−22
@@ -1,22 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− test = \x -> case x of
6− { str = "Foo", bool = true } -> true
7− { str = "Bar", bool = b } -> b
8− _ -> false
9−
10− f = \o -> case o of
11− { foo = "Foo" } -> o.bar
12− _ -> 0
13−
14− h = \o -> case o of
15− a@[_,_,_] -> a
16− _ -> []
17−
18− isDesc :: Array Number -> Boolean
19− isDesc [x, y] | x > y = true
20− isDesc _ = false
21−
22− main = Debug.Trace.trace "Done"
examples/passing/Person.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3− import Prelude ((++))
4−
5− data Person = Person { name :: String, age :: Number }
6−
7− foreign import itoa
8− """
9− function itoa(n) {
10− return n.toString();
11− }
12− """ :: Number -> String
13−
14− showPerson :: Person -> String
15− showPerson = \p -> case p of
16− Person o -> o.name ++ ", aged " ++ itoa(o.age)
17−
18− main = Debug.Trace.trace "Done"
examples/passing/Rank2Data.pursdeleted−29
@@ -1,29 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− data Id = Id forall a. a -> a
6−
7− runId = \id a -> case id of
8− Id f -> f a
9−
10− data Nat = Nat forall r. r -> (r -> r) -> r
11−
12− runNat = \nat -> case nat of
13− Nat f -> f 0.0 (\n -> n + 1.0)
14−
15− zero' = Nat (\zero' _ -> zero')
16−
17− succ = \n -> case n of
18− Nat f -> Nat (\zero' succ -> succ (f zero' succ))
19−
20− add = \n m -> case n of
21− Nat f -> case m of
22− Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)
23−
24− one' = succ zero'
25− two = succ zero'
26− four = add two two
27− fourNumber = runNat four
28−
29− main = Debug.Trace.trace "Done'"
examples/passing/Rank2Object.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−
5−data Foo = Foo { id :: forall a. a -> a }
6−
7−foo :: Foo -> Number
8−foo (Foo { id = f }) = f 0.0
9−
10−main = trace "Done"
examples/passing/Rank2TypeSynonym.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−
5−type Foo a = forall f. (Monad f) => f a
6−
7−foo :: forall a. a -> Foo a
8−foo x = pure x
9−
10−bar :: Foo Number
11−bar = foo 3.0
12−
13−main = do
14− x <- bar
15− Debug.Trace.print x
examples/passing/Rank2Types.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− test1 :: (forall a. (a -> a)) -> Number
6− test1 = \f -> f 0.0
7−
8− forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b
9− forever = \bind action -> bind action $ \_ -> forever bind action
10−
11− main = Debug.Trace.trace "Done"
examples/passing/RebindableSyntax.pursdeleted−37
@@ -1,37 +0,0 @@
1−module Main where
2−
3−example1 :: String
4−example1 = do
5− "Do"
6− " notation"
7− " for"
8− " Semigroup"
9− where
10− (>>=) x f = x <> f unit
11−
12−(*>) :: forall f a b. (Apply f) => f a -> f b -> f b
13−(*>) fa fb = const id <$> fa <*> fb
14−
15−newtype Const a b = Const a
16−
17−runConst :: forall a b. Const a b -> a
18−runConst (Const a) = a
19−
20−instance functorConst :: Functor (Const a) where
21− (<$>) _ (Const a) = Const a
22−
23−instance applyConst :: (Semigroup a) => Apply (Const a) where
24− (<*>) (Const a1) (Const a2) = Const (a1 <> a2)
25−
26−example2 :: Const String Unit
27−example2 = do
28− Const "Do"
29− Const " notation"
30− Const " for"
31− Const " Apply"
32− where
33− (>>=) x f = x *> f unit
34−
35−main = do
36− Debug.Trace.trace example1
37− Debug.Trace.trace $ runConst example2
examples/passing/Recursion.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− fib = \n -> case n of
6− 0.0 -> 1.0
7− 1.0 -> 1.0
8− n -> fib (n - 1.0) + fib (n - 2.0)
9−
10− main = Debug.Trace.trace "Done"
examples/passing/ReservedWords.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- See https://github.com/purescript/purescript/issues/606
2−module Main where
3−
4− o :: { type :: String }
5− o = { type: "o" }
6−
7− p :: { type :: String }
8− p = o { type = "p" }
9−
10− f :: forall r. { type :: String | r } -> String
11− f { type = "p" } = "Done"
12−
13− main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }
examples/passing/RowConstructors.pursdeleted−40
@@ -1,40 +0,0 @@
1−module Main where
2−
3−type Foo = (x :: Number | (y :: Number | (z :: Number)))
4−type Bar = (x :: Number, y :: Number, z :: Number)
5−type Baz = { w :: Number | Bar }
6−
7−foo :: { | Foo }
8−foo = { x: 0.0, y: 0.0, z: 0.0 }
9−
10−bar :: { | Bar }
11−bar = { x: 0.0, y: 0.0, z: 0.0 }
12−
13−id' :: Object Foo -> Object Bar
14−id' = id
15−
16−foo' :: { | Foo }
17−foo' = id' foo
18−
19−bar' :: { | Bar }
20−bar' = id' bar
21−
22−baz :: Baz
23−baz = { x: 0.0, y: 0.0, z: 0.0, w: 0.0 }
24−
25−type Quux r = (q :: Number | r)
26−type Norf r = (q' :: Number | Quux r)
27−
28−quux :: { f :: { | Foo } | Quux Bar }
29−quux = { f: foo', x: 0.0, y: 0.0, z: 0.0, q: 0.0 }
30−
31−quux' :: { | Norf Bar }
32−quux' = { x: 0.0, y: 0.0, z: 0.0, q: 0.0, q': 0.0 }
33−
34−wildcard :: { w :: Number | _ } -> Baz
35−wildcard { w: w } = { x: w, y: w, z: w, w: w }
36−
37−wildcard' :: { | Quux _ } -> Number
38−wildcard' { q: q } = q
39−
40−main = Debug.Trace.trace "Done"
examples/passing/RowPolyInstanceContext.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−class T s m where
4− state :: (s -> s) -> m Unit
5−
6−data S s a = S (s -> { new :: s, ret :: a })
7−
8−instance st :: T s (S s) where
9− state f = S $ \s -> { new: f s, ret: unit }
10−
11−test1 :: forall r . S { foo :: String | r } Unit
12−test1 = state $ \o -> o { foo = o.foo ++ "!" }
13−
14−test2 :: forall m r . (T { foo :: String | r } m) => m Unit
15−test2 = state $ \o -> o { foo = o.foo ++ "!" }
16−
17−main = do
18− let t1 = test1
19− let t2 = test2
20− Debug.Trace.trace "Done"
examples/passing/RowSynonyms.pursdeleted−46
@@ -1,46 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Control.Monad.ST
5−
6−type State bindings =
7− {
8− bindings :: {addition :: Number | bindings},
9− other :: String
10− }
11−
12−type MyBindings = (test :: Number)
13−
14−data Shadow bindings = Shadow String
15−
16−shadows :: Shadow (Object MyBindings)
17−shadows = Shadow "uhh"
18−
19−main :: Eff () Unit
20−main = withIt
21− shadows
22− \ bindings -> do
23− let state =
24− {
25− bindings : bindings,
26− other : "Test"
27− }
28− runST do
29− stRef <- newSTRef state
30− handleKeyD stRef
31− return unit
32−
33−
34−withIt :: forall bindings eff a. Shadow (Object bindings) ->
35− ({addition :: Number | bindings} -> Eff eff a) -> Eff eff a
36−withIt (Shadow str) success = do
37− b <- withBindings
38− success (b{addition = 1.0})
39−
40−foreign import withBindings
41−"""
42− function withBindings() {}
43−""" :: forall eff bindings. Eff eff bindings
44−
45−handleKeyD :: forall h eff. STRef h (State MyBindings) -> Eff (st :: ST h | eff) Unit
46−handleKeyD state = return unit
examples/passing/RuntimeScopeIssue.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class A a where
6− a :: a -> Boolean
7−
8−class B a where
9− b :: a -> Boolean
10−
11−instance aNumber :: A Number where
12− a 0.0 = true
13− a n = b (n - 1.0)
14−
15−instance bNumber :: B Number where
16− b 0.0 = false
17− b n = a (n - 1.0)
18−
19−main = Debug.Trace.print $ a 10.0
examples/passing/ScopedTypeVariables.pursdeleted−34
@@ -1,34 +0,0 @@
1−module Main where
2−
3−test1 :: forall a. (a -> a) -> a -> a
4−test1 f x = g (g x)
5− where
6− g :: a -> a
7− g y = f (f y)
8−
9−test2 :: forall a. (a -> a) -> a -> a
10−test2 = h
11− where
12− h :: forall b. (b -> b) -> b -> b
13− h f x = g (g x)
14− where
15− g :: b -> b
16− g y = f (f y)
17−
18−test3 :: Number
19−test3 = ((\b -> b :: b) :: forall b. b -> b) 0.0
20−
21−test4 :: forall a. (a -> a) -> a -> a
22−test4 = h
23− where
24− h :: forall b. (b -> b) -> b -> b
25− h f x = g (g x)
26− where
27− g :: b -> b
28− g y = j (f (f y))
29− where
30− j :: forall b. b -> b
31− j x = x
32−
33−
34−main = Debug.Trace.trace "Done"
examples/passing/Sequence.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−
5−data List a = Cons a (List a) | Nil
6−
7−class Sequence t where
8− sequence :: forall m a. (Monad m) => t (m a) -> m (t a)
9−
10−instance sequenceList :: Sequence List where
11− sequence Nil = pure Nil
12− sequence (Cons x xs) = Cons <$> x <*> sequence xs
13−
14−main = sequence $ Cons (Debug.Trace.trace "Done") Nil
examples/passing/SequenceDesugared.pursdeleted−36
@@ -1,36 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−
5−data List a = Cons a (List a) | Nil
6−
7−data Sequence t = Sequence (forall m a. (Monad m) => t (m a) -> m (t a))
8−
9−sequence :: forall t. Sequence t -> (forall m a. (Monad m) => t (m a) -> m (t a))
10−sequence (Sequence s) = s
11−
12−sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a)
13−sequenceListSeq Nil = pure Nil
14−sequenceListSeq (Cons x xs) = Cons <$> x <*> sequenceListSeq xs
15−
16−sequenceList :: Sequence List
17−sequenceList = Sequence (sequenceListSeq)
18−
19−sequenceList' :: Sequence List
20−sequenceList' = Sequence ((\val -> case val of
21− Nil -> pure Nil
22− Cons x xs -> Cons <$> x <*> sequence sequenceList' xs))
23−
24−sequenceList'' :: Sequence List
25−sequenceList'' = Sequence (sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a))
26−
27−sequenceList''' :: Sequence List
28−sequenceList''' = Sequence ((\val -> case val of
29− Nil -> pure Nil
30− Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))
31−
32−main = do
33− sequence sequenceList $ Cons (Debug.Trace.trace "Done") Nil
34− sequence sequenceList' $ Cons (Debug.Trace.trace "Done") Nil
35− sequence sequenceList'' $ Cons (Debug.Trace.trace "Done") Nil
36− sequence sequenceList''' $ Cons (Debug.Trace.trace "Done") Nil
examples/passing/ShadowedRename.pursdeleted−21
@@ -1,21 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Debug.Trace
5−
6−foreign import f
7− """
8− function f(x) {
9− return function() {
10− if (x !== 2.0) throw new Error('x is not 2.0');
11− };
12− }
13− """ :: forall e. Number -> Eff e Number
14−
15−foo foo = let foo_1 = \_ -> foo
16− foo_2 = foo_1 unit + 1.0
17− in foo_2
18−
19−main = do
20− f (foo 1.0)
21− trace "Done"
examples/passing/ShadowedTCO.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−runNat f = f 0.0 (\n -> n + 1.0)
4−
5−zero' z _ = z
6−
7−succ f zero' succ = succ (f zero' succ)
8−
9−add f g zero' succ = g (f zero' succ) succ
10−
11−one' = succ zero'
12−two = succ one'
13−four = add two two
14−fourNumber = runNat four
15−
16−main = Debug.Trace.trace $ show fourNumber
examples/passing/ShadowedTCOLet.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−f x y z =
4− let f 1.0 2.0 3.0 = 1.0
5− in f x z y
6−
7−main = Debug.Trace.trace $ show $ f 1.0 3.0 2.0
examples/passing/SignedNumericLiterals.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3− p = 0.5
4− q = 1.0
5− x = -1.0
6− y = -0.5
7− z = 0.5
8− w = 1.0
9−
10− f :: Number -> Number
11− f x = -x
12−
13− test1 = 2.0 - 1.0
14−
15− main = Debug.Trace.trace "Done"
examples/passing/Superclasses1.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−class Su a where
4− su :: a -> a
5−
6−class (Su a) <= Cl a where
7− cl :: a -> a -> a
8−
9−instance suNumber :: Su Number where
10− su n = n + 1.0
11−
12−instance clNumber :: Cl Number where
13− cl n m = n + m
14−
15−test :: forall a. (Cl a) => a -> a
16−test a = su (cl a a)
17−
18−main = Debug.Trace.print $ test 10.0
examples/passing/Superclasses2.pursdeleted−23
@@ -1,23 +0,0 @@
1−module Main where
2−
3−import Prelude.Unsafe (unsafeIndex)
4−
5−class Su a where
6− su :: a -> a
7−
8−class (Su (Array a)) <= Cl a where
9− cl :: a -> a -> a
10−
11−instance suNumber :: Su Number where
12− su n = n + 1.0
13−
14−instance suArray :: (Su a) => Su (Array a) where
15− su [x] = [su x]
16−
17−instance clNumber :: Cl Number where
18− cl n m = n + m
19−
20−test :: forall a. (Cl a) => a -> Array a
21−test x = su [cl x x]
22−
23−main = Debug.Trace.print $ test 10.0 `unsafeIndex` 0.0
examples/passing/Superclasses3.pursdeleted−41
@@ -1,41 +0,0 @@
1−module Main where
2−
3−import Debug.Trace
4−
5−import Control.Monad.Eff
6−
7−class (Monad m) <= MonadWriter w m where
8− tell :: w -> m Unit
9−
10−testFunctor :: forall m. (Monad m) => m Number -> m Number
11−testFunctor n = (+) 1.0 <$> n
12−
13−test :: forall w m. (Monad m, MonadWriter w m) => w -> m Unit
14−test w = do
15− tell w
16− tell w
17− tell w
18−
19−data MTrace a = MTrace (Eff (trace :: Trace) a)
20−
21−runMTrace :: forall a. MTrace a -> Eff (trace :: Trace) a
22−runMTrace (MTrace a) = a
23−
24−instance functorMTrace :: Functor MTrace where
25− (<$>) = liftM1
26−
27−instance applyMTrace :: Apply MTrace where
28− (<*>) = ap
29−
30−instance applicativeMTrace :: Applicative MTrace where
31− pure = MTrace <<< return
32−
33−instance bindMTrace :: Bind MTrace where
34− (>>=) m f = MTrace (runMTrace m >>= (runMTrace <<< f))
35−
36−instance monadMTrace :: Monad MTrace
37−
38−instance writerMTrace :: MonadWriter String MTrace where
39− tell s = MTrace (trace s)
40−
41−main = runMTrace $ test "Done"
examples/passing/TCOCase.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−data Data = One | More Data
4−
5−main = Debug.Trace.trace (from (to 10000.0 One))
6− where
7− to 0.0 a = a
8− to n a = to (n - 1.0) (More a)
9− from One = "Done"
10− from (More d) = from d
examples/passing/TailCall.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data L a = C a (L a) | N
6−
7−test :: Number -> L Number -> Number
8−test n N = n
9−test n (C x xs) = test (n + x) xs
10−
11−loop :: forall a. Number -> a
12−loop x = loop (x + 1.0)
13−
14−notATailCall = \x ->
15− (\notATailCall -> notATailCall x) (\x -> x)
16−
17−main = Debug.Trace.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))
examples/passing/Tick.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3−test' x = x
4−
5−main = Debug.Trace.trace "Done"
examples/passing/TopLevelCase.pursdeleted−28
@@ -1,28 +0,0 @@
1−module Main where
2−
3−foreign import jsMod
4− """
5− function jsMod(x) {
6− return function (y) {
7− return x % y;
8− };
9− }
10− """ :: Number -> Number -> Number
11−
12−infixl 7 %
13−(%) = jsMod
14−
15−gcd :: Number -> Number -> Number
16−gcd 0.0 x = x
17−gcd x 0.0 = x
18−gcd x y | x > y = gcd (x % y) y
19−gcd x y = gcd (y % x) x
20−
21−guardsTest [x] | x > 0.0 = []
22−guardsTest xs = xs
23−
24−data A = A
25−
26−parseTest A 0.0 = 0.0
27−
28−main = Debug.Trace.trace "Done"
examples/passing/TypeClassImport.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−foreign import data T :: *
4−
5−foreign import data C :: *
6−
7−foreign import t "var t = null;" :: T
8−
9−foreign import inst """
10− var inst = {
11− show: function(t) {
12− return 'Done';
13− }
14− }""" :: C
15−
16−foreign import instance inst :: Show T
17−
18−main = Debug.Trace.print t
examples/passing/TypeClassMemberOrderChange.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−class Test a where
4− fn :: a -> a -> a
5− val :: a
6−
7−instance testBoolean :: Test Boolean where
8− val = true
9− fn x y = y
10−
11−main = Debug.Trace.trace (show (fn true val))
examples/passing/TypeClasses.pursdeleted−69
@@ -1,69 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−test1 = \_ -> show "testing"
6−
7−f :: forall a. (Prelude.Show a) => a -> String
8−f x = show x
9−
10−test2 = \_ -> f "testing"
11−
12−test7 :: forall a. (Prelude.Show a) => a -> String
13−test7 = show
14−
15−test8 = \_ -> show $ "testing"
16−
17−data Data a = Data a
18−
19−instance showData :: (Prelude.Show a) => Prelude.Show (Data a) where
20− show (Data a) = "Data (" ++ show a ++ ")"
21−
22−test3 = \_ -> show (Data "testing")
23−
24−instance functorData :: Functor Data where
25− (<$>) = liftM1
26−
27−instance applyData :: Apply Data where
28− (<*>) = ap
29−
30−instance applicativeData :: Applicative Data where
31− pure = Data
32−
33−instance bindData :: Bind Data where
34− (>>=) (Data a) f = f a
35−
36−instance monadData :: Monad Data
37−
38−data Maybe a = Nothing | Just a
39−
40−instance functorMaybe :: Functor Maybe where
41− (<$>) = liftM1
42−
43−instance applyMaybe :: Apply Maybe where
44− (<*>) = ap
45−
46−instance applicativeMaybe :: Applicative Maybe where
47− pure = Just
48−
49−instance bindMaybe :: Bind Maybe where
50− (>>=) Nothing _ = Nothing
51− (>>=) (Just a) f = f a
52−
53−instance monadMaybe :: Monad Maybe
54−
55−test4 :: forall a m. (Monad m) => a -> m Number
56−test4 = \_ -> return 1.0
57−
58−test5 = \_ -> Just 1.0 >>= \n -> return (n + 1.0)
59−
60−ask r = r
61−
62−runReader r f = f r
63−
64−test9 _ = runReader 0.0 $ do
65− n <- ask
66− return $ n + 1.0
67−
68−main = Debug.Trace.trace (test7 "Done")
69−
examples/passing/TypeClassesInOrder.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class Foo a where
6− foo :: a -> String
7−
8−instance fooString :: Foo String where
9− foo s = s
10−
11−main = Debug.Trace.trace $ foo "Done"
examples/passing/TypeClassesWithOverlappingTypeVariables.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− data Either a b = Left a | Right b
6−
7− instance functorEither :: Prelude.Functor (Either a) where
8− (<$>) _ (Left x) = Left x
9− (<$>) f (Right y) = Right (f y)
10−
11− main = Debug.Trace.trace "Done"
examples/passing/TypeDecl.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3− import Prelude
4−
5− k :: String -> Number -> String
6− k x y = x
7−
8− iterate :: forall a. Number -> (a -> a) -> a -> a
9− iterate 0.0 f a = a
10− iterate n f a = iterate (n - 1.0) f (f a)
11−
12− main = Debug.Trace.trace "Done"
examples/passing/TypeSynonymInData.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−type A a = Array a
4−
5−data Foo a = Foo (A a) | Bar
6−
7−foo (Foo []) = Bar
8−
9−main = Debug.Trace.trace "Done"
examples/passing/TypeSynonyms.pursdeleted−25
@@ -1,25 +0,0 @@
1−module Main where
2−
3− type Lens a b =
4− { get :: a -> b
5− , set :: a -> b -> a
6− }
7−
8− composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c
9− composeLenses = \l1 -> \l2 ->
10− { get: \a -> l2.get (l1.get a)
11− , set: \a c -> l1.set a (l2.set (l1.get a) c)
12− }
13−
14− type Pair a b = { fst :: a, snd :: b }
15−
16− fst :: forall a b. Lens (Pair a b) a
17− fst =
18− { get: \p -> p.fst
19− , set: \p a -> { fst: a, snd: p.snd }
20− }
21−
22− test1 :: forall a b c. Lens (Pair (Pair a b) c) a
23− test1 = composeLenses fst fst
24−
25− main = Debug.Trace.trace "Done"
examples/passing/TypeWildcards.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−testTopLevel :: _ -> _
4−testTopLevel n = n + 1.0
5−
6−test :: forall a. (Eq a) => (a -> a) -> a -> a
7−test f a = go (f a) a
8− where
9− go :: _ -> _ -> _
10− go a1 a2 | a1 == a2 = a1
11− go a1 _ = go (f a1) a1
12−
13−main = Debug.Trace.trace "Done"
examples/passing/TypeWildcardsRecordExtension.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−foo :: forall a. {b :: Number | a} -> {b :: Number | _}
4−foo f = f
5−
6−main = Debug.Trace.trace "Done"
examples/passing/TypedWhere.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−data E a b = L a | R b
4−
5−data L a = C a (L a) | N
6−
7−lefts :: forall a b. L (E a b) -> L a
8−lefts = go N
9− where
10− go :: forall a b. L a -> L (E a b) -> L a
11− go ls N = ls
12− go ls (C (L a) rest) = go (C a ls) rest
13− go ls (C _ rest) = go ls rest
14−
15−main = Debug.Trace.trace "Done"
examples/passing/UnderscoreIdent.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−data Data_type = Con_Structor | Con_2 String
4−
5−type Type_name = Data_type
6−
7−done (Con_2 s) = s
8−
9−main = Debug.Trace.trace (done (Con_2 "Done"))
examples/passing/Unit.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Debug.Trace
5−
6−main = print (const unit $ "Hello world")
examples/passing/UnknownInTypeClassLookup.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−class EQ a b
4−
5−instance eqAA :: EQ a a
6−
7−test :: forall a b. (EQ a b) => a -> b -> String
8−test _ _ = "Done"
9−
10−runTest a = test a a
11−
12−main = Debug.Trace.trace $ runTest 0.0
examples/passing/Where.pursdeleted−49
@@ -1,49 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−
7−test1 x = y
8− where
9− y :: Number
10− y = x + 1.0
11−
12−test2 x y = x' + y'
13− where
14− x' = x + 1.0
15− y' = y + 1.0
16−
17−
18−test3 = f 1.0 2.0 3.0
19− where f x y z = x + y + z
20−
21−
22−test4 = f (+) [1.0, 2.0]
23− where f x [y, z] = x y z
24−
25−
26−test5 = g 10.0
27− where
28− f x | x > 0.0 = g (x / 2.0) + 1.0
29− f x = 0.0
30− g x = f (x - 1.0) + 1.0
31−
32−test6 = if f true then f 1.0 else f 2.0
33− where f :: forall a. a -> a
34− f x = x
35−
36−test7 :: Number -> Number
37−test7 x = go x
38− where
39− go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
40− go y = go $ (y + x / y) / 2.0
41−
42−main = do
43− Debug.Trace.print (test1 1.0)
44− Debug.Trace.print (test2 1.0 2.0)
45− Debug.Trace.print test3
46− Debug.Trace.print test4
47− Debug.Trace.print test5
48− Debug.Trace.print test6
49− Debug.Trace.print (test7 100.0)
examples/passing/iota.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3− s = \x -> \y -> \z -> x z (y z)
4−
5− k = \x -> \y -> x
6−
7− iota = \x -> x s k
8−
9− main = Debug.Trace.trace "Done"
examples/passing/s.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3− s = \x y z -> x z (y z)
4−
5− main = Debug.Trace.trace "Done"
hierarchy/Main.hsdeleted−110
@@ -1,110 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Hardy Jones 2014
5−-- License : MIT
6−--
7−-- Maintainer : Hardy Jones <jones3.hardy@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Generate Directed Graphs of PureScript TypeClasses
13−--
14−-----------------------------------------------------------------------------
15−
16−module Main where
17−
18−import Control.Monad (unless)
19−
20−import Data.List (intercalate,nub,sort)
21−import Data.Foldable (for_)
22−import Data.Version (showVersion)
23−
24−import Options.Applicative
25−import System.Directory (createDirectoryIfMissing)
26−import System.FilePath ((</>))
27−import System.Exit (exitFailure, exitSuccess)
28−import System.IO (hPutStr, stderr)
29−
30−import qualified Language.PureScript as P
31−import qualified Paths_purescript as Paths
32−
33−data HierarchyOptions = HierarchyOptions
34− { hierachyInput :: FilePath
35− , hierarchyOutput :: Maybe FilePath
36− }
37−
38−newtype SuperMap = SuperMap { unSuperMap :: Either P.ProperName (P.ProperName, P.ProperName) }
39− deriving Eq
40−
41−instance Show SuperMap where
42− show (SuperMap (Left sub)) = show sub
43− show (SuperMap (Right (super, sub))) = show super ++ " -> " ++ show sub
44−
45−instance Ord SuperMap where
46− compare (SuperMap s) (SuperMap s') = getCls s `compare` getCls s'
47− where
48− getCls = either id snd
49−
50−runModuleName :: P.ModuleName -> String
51−runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
52−
53−readInput :: FilePath -> IO (Either P.MultipleErrors [P.Module])
54−readInput filename = do
55− content <- readFile filename
56− return $ map snd <$> P.parseModulesFromFiles id [(filename, content)]
57−
58−compile :: HierarchyOptions -> IO ()
59−compile (HierarchyOptions input mOutput) = do
60− modules <- readInput input
61− case modules of
62− Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure
63− Right ms -> do
64− for_ ms $ \(P.Module _ moduleName decls _) ->
65− let name = runModuleName moduleName
66− tcs = filter P.isTypeClassDeclaration decls
67− supers = sort . nub . filter (not . null) $ fmap superClasses tcs
68− prologue = "digraph " ++ name ++ " {\n"
69− body = intercalate "\n" (concatMap (fmap (\s -> " " ++ show s ++ ";")) supers)
70− epilogue = "\n}"
71− hier = prologue ++ body ++ epilogue
72− in unless (null supers) $ case mOutput of
73− Just output -> do
74− createDirectoryIfMissing True output
75− writeFile (output </> name) hier
76− Nothing -> putStrLn hier
77− exitSuccess
78−
79−superClasses :: P.Declaration -> [SuperMap]
80−superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =
81− fmap (\(P.Qualified _ super, _) -> SuperMap (Right (super, sub))) supers
82−superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]
83−superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl
84−superClasses _ = []
85−
86−inputFile :: Parser FilePath
87−inputFile = strArgument $
88− metavar "FILE"
89− <> value "main.purs"
90− <> showDefault
91− <> help "The input file to generate a hierarchy from"
92−
93−outputFile :: Parser (Maybe FilePath)
94−outputFile = optional . strOption $
95− short 'o'
96− <> long "output"
97− <> help "The output directory"
98−
99−pscOptions :: Parser HierarchyOptions
100−pscOptions = HierarchyOptions <$> inputFile
101− <*> outputFile
102−
103−main :: IO ()
104−main = execParser opts >>= compile
105− where
106− opts = info (helper <*> pscOptions) infoModList
107− infoModList = fullDesc <> headerInfo <> footerInfo
108− headerInfo = header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"
109− footerInfo = footer $ "hierarchy " ++ showVersion Paths.version
110−
license-generator/generatedeleted−44
@@ -1,44 +0,0 @@
1−#!/bin/bash
2−# Generates the LICENSE file and prints it to standard output.
3−# Example use:
4−#
5−# ./license/generate > LICENSE
6−#
7−
8−set -e # exit on error
9−set -u # exit on undefined variable
10−set -o pipefail # propagate nonzero exit codes through pipelines
11−
12−if ! which cabal-dependency-licenses >/dev/null; then
13− echo "$0: the program 'cabal-dependency-licenses' is required." >&2
14− echo "$0: see Hackage: https://hackage.haskell.org/package/cabal-dependency-licenses" >&2
15− exit 1
16−fi
17−
18−echo_header() {
19− cat license-generator/header.txt
20−}
21−
22−echo_deps_names() {
23− cabal-dependency-licenses \
24− | grep '^- ' | sed 's/^..//' | sort -h
25−}
26−
27−echo_deps_licenses() {
28− while read dep; do
29− echo "fetching LICENSE for: ${dep}" >&2
30− echo "${dep} LICENSE file:"
31− echo ""
32− curl --silent "https://hackage.haskell.org/package/${dep}/src/LICENSE" \
33− | sed 's/^/ /g' # indent by 2 characters
34− echo ""
35− done
36−}
37−
38−echo_deps_names > license-generator/tmp/deps.txt
39−
40−echo_header
41−echo ""
42−sed <license-generator/tmp/deps.txt 's/^/ /'
43−echo ""
44−echo_deps_licenses <license-generator/tmp/deps.txt
license-generator/header.txtdeleted−23
@@ -1,23 +0,0 @@
1−The MIT License (MIT)
2−
3−Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other
4−contributors
5−
6−Permission is hereby granted, free of charge, to any person obtaining a copy of
7−this software and associated documentation files (the "Software"), to deal in
8−the Software without restriction, including without limitation the rights to
9−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
10−the Software, and to permit persons to whom the Software is furnished to do so,
11−subject to the following conditions:
12−
13−The above copyright notice and this permission notice shall be included in all
14−copies or substantial portions of the Software.
15−
16−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
18−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
19−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
20−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
21−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22−
23−PureScript uses the following Haskell library packages. Their license files follow.
license-generator/tmp/.gitkeepdeleted

No changes to the content.

logo.pngdeleted

Binary file not shown.

package.yamlnew file+86
@@ -0,0 +1,86 @@
1+name: psgo
2+version: 0.1.0.0
3+github: "andyarvanitis/purescript-native"
4+license: BSD3
5+author: "Andy Arvanitis"
6+maintainer: "example@example.com"
7+copyright: "2018 Andy Arvanitis"
8+
9+extra-source-files:
10+- README.md
11+- ChangeLog.md
12+- stack.yaml
13+- support/*
14+
15+# Metadata used when publishing your package
16+# synopsis: Short description of your package
17+# category: Web
18+
19+# To avoid duplicated efforts in documentation and dealing with the
20+# complications of embedding Haddock markup inside cabal files, it is
21+# common to point users to the README.md file.
22+description: Please see the README on Github at <https://github.com/andyarvanitis/purescript-native#readme>
23+
24+dependencies:
25+- base >= 4.7 && < 5
26+- bytestring >= 0.10.8.2 && < 0.11
27+- purescript
28+- base-compat >=0.6.0
29+- protolude >=0.1.6
30+- text
31+- containers
32+- filepath
33+- monad-parallel >= 0.7.2.2 && <0.8
34+- pattern-arrows >=0.0.2 && <0.1
35+- safe >=0.3.9 && <0.4
36+- transformers >=0.3.0 && <0.6
37+- mtl >=2.1.0 && <2.3.0
38+- aeson >=1.0 && <1.5
39+- directory
40+- process
41+- file-embed
42+- filemanip
43+- gitrev
44+
45+library:
46+ source-dirs: src
47+ default-extensions:
48+ - ConstraintKinds
49+ - DataKinds
50+ - DeriveFunctor
51+ - EmptyDataDecls
52+ - FlexibleContexts
53+ - KindSignatures
54+ - LambdaCase
55+ - MultiParamTypeClasses
56+ - NoImplicitPrelude
57+ - PatternGuards
58+ - PatternSynonyms
59+ - RankNTypes
60+ - RecordWildCards
61+ - OverloadedStrings
62+ - ScopedTypeVariables
63+ - TupleSections
64+ - ViewPatterns
65+
66+executables:
67+ psgo:
68+ main: Main.hs
69+ source-dirs: app
70+ ghc-options:
71+ - -threaded
72+ - -rtsopts
73+ - -with-rtsopts=-N
74+ dependencies:
75+ - psgo
76+
77+tests:
78+ psgo-test:
79+ main: Spec.hs
80+ source-dirs: test
81+ ghc-options:
82+ - -threaded
83+ - -rtsopts
84+ - -with-rtsopts=-N
85+ dependencies:
86+ - psgo
psc-docs/Ctags.hsdeleted−13
@@ -1,13 +0,0 @@
1−module Ctags (dumpCtags) where
2−
3−import qualified Language.PureScript as P
4−import Tags
5−import Data.List (sort)
6−
7−dumpCtags :: [(String, P.Module)] -> [String]
8−dumpCtags = sort . concat . (map renderModCtags)
9−
10−renderModCtags :: (String, P.Module) -> [String]
11−renderModCtags (path, mdl) = sort tagLines
12− where tagLines = map tagLine $ tags mdl
13− tagLine (name, line) = name ++ "\t" ++ path ++ "\t" ++ show line
psc-docs/Etags.hsdeleted−15
@@ -1,15 +0,0 @@
1−module Etags (dumpEtags) where
2−
3−import qualified Language.PureScript as P
4−import Tags
5−
6−dumpEtags :: [(String, P.Module)] -> [String]
7−dumpEtags = concat . (map renderModEtags)
8−
9−renderModEtags :: (String, P.Module) -> [String]
10−renderModEtags (path, mdl) = ["\x0c", path ++ "," ++ show tagsLen] ++ tagLines
11− where tagsLen = sum $ map length tagLines
12− tagLines = map tagLine $ tags mdl
13− tagLine (name, line) = "\x7f" ++ name ++ "\x01" ++ show line ++ ","
14−
15−
psc-docs/Main.hsdeleted−249
@@ -1,249 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−----------------------------------------------------------------------------
3−--
4−-- Module : Main
5−-- Copyright : (c) Phil Freeman 2013
6−-- License : MIT
7−--
8−-- Maintainer : Phil Freeman <paf31@cantab.net>
9−-- Stability : experimental
10−-- Portability :
11−--
12−-- |
13−--
14−-----------------------------------------------------------------------------
15−
16−module Main where
17−
18−import Control.Applicative
19−import Control.Arrow (first, second)
20−import Control.Category ((>>>))
21−import Control.Monad.Writer
22−import Data.Function (on)
23−import Data.List
24−import Data.Maybe (fromMaybe)
25−import Data.Tuple (swap)
26−import Data.Version (showVersion)
27−
28−import Options.Applicative
29−import qualified Text.PrettyPrint.ANSI.Leijen as PP
30−
31−import qualified Language.PureScript as P
32−import qualified Paths_purescript as Paths
33−import System.Exit (exitFailure)
34−import System.IO (hPutStrLn, stderr)
35−import System.Directory (createDirectoryIfMissing)
36−import System.FilePath (takeDirectory)
37−
38−import Etags
39−import Ctags
40−import qualified Language.PureScript.Docs as D
41−import qualified Language.PureScript.Docs.AsMarkdown as D
42−
43−-- Available output formats
44−data Format = Markdown -- Output documentation in Markdown format
45− | Ctags -- Output ctags symbol index suitable for use with vi
46− | Etags -- Output etags symbol index suitable for use with emacs
47− deriving (Show, Eq, Ord)
48−
49−-- | Available methods of outputting Markdown documentation
50−data DocgenOutput
51− = EverythingToStdOut
52− | ToStdOut [P.ModuleName]
53− | ToFiles [(P.ModuleName, FilePath)]
54− deriving (Show)
55−
56−data PSCDocsOptions = PSCDocsOptions
57− { pscdFormat :: Format
58− , pscdInputFiles :: [FilePath]
59− , pscdDocgen :: DocgenOutput
60− }
61− deriving (Show)
62−
63−docgen :: PSCDocsOptions -> IO ()
64−docgen (PSCDocsOptions fmt input output) =
65− case fmt of
66− Etags -> dumpTags input dumpEtags
67− Ctags -> dumpTags input dumpCtags
68− Markdown -> do
69− e <- D.parseAndDesugar input [] (\_ ms -> return ms)
70− case e of
71− Left (D.ParseError err) -> do
72− hPutStrLn stderr $ show err
73− exitFailure
74− Left (D.SortModulesError err) -> do
75− hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
76− exitFailure
77− Left (D.DesugarError err) -> do
78− hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
79− exitFailure
80− Right ms' ->
81− case output of
82− EverythingToStdOut ->
83− putStrLn (D.renderModulesAsMarkdown ms')
84− ToStdOut names -> do
85− let (ms, missing) = takeModulesByName ms' names
86− guardMissing missing
87− putStrLn (D.renderModulesAsMarkdown ms)
88− ToFiles names -> do
89− let (ms, missing) = takeModulesByName' ms' names
90− guardMissing missing
91− let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
92− forM_ ms'' $ \grp -> do
93− let fp = fst (head grp)
94− createDirectoryIfMissing True (takeDirectory fp)
95− writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
96− where
97− guardMissing [] = return ()
98− guardMissing [mn] = do
99− hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
100− exitFailure
101− guardMissing mns = do
102− hPutStrLn stderr "psc-docs: error: unknown modules:"
103− forM_ mns $ \mn ->
104− hPutStrLn stderr (" * " ++ show mn)
105− exitFailure
106−
107−-- |
108−-- Given a list of module names and a list of modules, return a list of modules
109−-- whose names appeared in the given name list, together with a list of names
110−-- for which no module could be found in the module list.
111−--
112−takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
113−takeModulesByName modules names =
114− first (map fst) (takeModulesByName' modules (map (,()) names))
115−
116−-- |
117−-- Like takeModulesByName but also keeps some extra data with the module.
118−--
119−takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
120−takeModulesByName' modules = foldl go ([], [])
121− where
122− go (ms, missing) (name, x) =
123− case find ((== name) . P.getModuleName) modules of
124− Just m -> ((m, x) : ms, missing)
125− Nothing -> (ms, name : missing)
126−
127−dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
128−dumpTags input renderTags = do
129− e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
130− case e of
131− Left err -> do
132− hPutStrLn stderr (show err)
133− exitFailure
134− Right ms ->
135− ldump (renderTags (pairs ms))
136−
137− where
138− pairs :: [(Maybe String, m)] -> [(String, m)]
139− pairs = map (first (fromMaybe ""))
140−
141− ldump :: [String] -> IO ()
142− ldump = mapM_ putStrLn
143−
144−parseFile :: FilePath -> IO (FilePath, String)
145−parseFile input = (,) input <$> readFile input
146−
147−inputFile :: Parser FilePath
148−inputFile = strArgument $
149− metavar "FILE"
150− <> help "The input .purs file(s)"
151−
152−instance Read Format where
153− readsPrec _ "etags" = [(Etags, "")]
154− readsPrec _ "ctags" = [(Ctags, "")]
155− readsPrec _ "markdown" = [(Markdown, "")]
156− readsPrec _ _ = []
157−
158−format :: Parser Format
159−format = option auto $ value Markdown
160− <> long "format"
161− <> metavar "FORMAT"
162− <> help "Set output FORMAT (markdown | etags | ctags)"
163−
164−docgenModule :: Parser String
165−docgenModule = strOption $
166− long "docgen"
167− <> help "A list of module names which should appear in the output. This can optionally include file paths to write individual modules to, by separating with a colon ':'. For example, Prelude:docs/Prelude.md. This option may be specified multiple times."
168−
169−pscDocsOptions :: Parser (Format, [FilePath], [String])
170−pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
171−
172−parseDocgen :: [String] -> Either String DocgenOutput
173−parseDocgen [] = Right EverythingToStdOut
174−parseDocgen xs = go xs
175− where
176− go = intersperse " "
177− >>> concat
178− >>> words
179− >>> map parseItem
180− >>> combine
181−
182−data DocgenOutputItem
183− = IToStdOut P.ModuleName
184− | IToFile (P.ModuleName, FilePath)
185−
186−parseItem :: String -> DocgenOutputItem
187−parseItem s = case elemIndex ':' s of
188− Just i ->
189− s # splitAt i
190− >>> first P.moduleNameFromString
191− >>> second (drop 1)
192− >>> IToFile
193− Nothing ->
194− IToStdOut (P.moduleNameFromString s)
195−
196− where
197− infixr 1 #
198− (#) = flip ($)
199−
200−combine :: [DocgenOutputItem] -> Either String DocgenOutput
201−combine [] = Right EverythingToStdOut
202−combine (x:xs) = foldM go (initial x) xs
203− where
204− initial (IToStdOut m) = ToStdOut [m]
205− initial (IToFile m) = ToFiles [m]
206−
207− go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
208− go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
209− go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
210−
211−buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
212−buildOptions (fmt, input, mapping) =
213− case parseDocgen mapping of
214− Right mapping' -> return (PSCDocsOptions fmt input mapping')
215− Left err -> do
216− hPutStrLn stderr "psc-docs: error in --docgen option:"
217− hPutStrLn stderr (" " ++ err)
218− exitFailure
219−
220−main :: IO ()
221−main = execParser opts >>= buildOptions >>= docgen
222− where
223− opts = info (version <*> helper <*> pscDocsOptions) infoModList
224− infoModList = fullDesc <> headerInfo <> footerInfo
225− headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
226− footerInfo = footerDoc $ Just $ PP.vcat
227− [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
228−
229− version :: Parser (a -> a)
230− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
231−
232−examples :: PP.Doc
233−examples =
234− PP.vcat $ map PP.text
235− [ "Examples:"
236− , " print documentation for Data.List to stdout:"
237− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
238− , " --docgen Data.List"
239− , ""
240− , " write documentation for Data.List to docs/Data.List.md:"
241− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
242− , " --docgen Data.List:docs/Data.List.md"
243− , ""
244− , " write documentation for Data.List to docs/Data.List.md, and"
245− , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
246− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
247− , " --docgen Data.List:docs/Data.List.md \\"
248− , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
249− ]
psc-docs/Tags.hsdeleted−18
@@ -1,18 +0,0 @@
1−module Tags where
2−
3−import qualified Language.PureScript as P
4−
5−tags :: P.Module -> [(String, Int)]
6−tags = concatMap dtags . P.exportedDeclarations
7− where dtags (P.PositionedDeclaration sp _ d) = map tag $ names d
8− where tag name = (name, line)
9− line = P.sourcePosLine $ P.spanStart sp
10− dtags _ = []
11− names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames
12− where consNames = map (\(cname, _) -> P.runProperName cname) dcons
13− names (P.TypeDeclaration ident _) = [show ident]
14− names (P.ExternDeclaration ident _) = [show ident]
15− names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]
16− names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]
17− names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]
18− names _ = []
psc-make/Main.hsdeleted−171
@@ -1,171 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DataKinds #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE RecordWildCards #-}
18−{-# LANGUAGE TupleSections #-}
19−
20−module Main where
21−
22−import Control.Applicative
23−import Control.Monad
24−import Control.Monad.Error.Class (MonadError(..))
25−import Control.Monad.Writer
26−
27−import Data.Version (showVersion)
28−import qualified Data.Map as M
29−
30−import Options.Applicative as Opts
31−
32−import System.Exit (exitSuccess, exitFailure)
33−import System.IO (hPutStrLn, stderr)
34−
35−import qualified Language.PureScript as P
36−import qualified Paths_purescript as Paths
37−
38−import Make
39−
40−data PSCMakeOptions = PSCMakeOptions
41− { pscmInput :: [FilePath]
42− , pscmForeignInput :: [FilePath]
43− , pscmOutputDir :: FilePath
44− , pscmOpts :: P.Options P.Make
45− , pscmUsePrefix :: Bool
46− }
47−
48−data InputOptions = InputOptions
49− { ioNoPrelude :: Bool
50− , ioInputFiles :: [FilePath]
51− }
52−
53−compile :: PSCMakeOptions -> IO ()
54−compile (PSCMakeOptions input inputForeign outputDir opts usePrefix) = do
55− moduleFiles <- readInput (InputOptions (P.optionsNoPrelude opts) input)
56− foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
57− case runWriterT (parseInputs moduleFiles foreignFiles) of
58− Left errs -> do
59− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
60− exitFailure
61− Right ((ms, foreigns), warnings) -> do
62− when (P.nonEmpty warnings) $
63− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
64− let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms
65− makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix
66− e <- runMake opts $ P.make makeActions ms
67− case e of
68− Left errs -> do
69− putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
70− exitFailure
71− Right (_, warnings') -> do
72− when (P.nonEmpty warnings') $
73− putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
74− exitSuccess
75−
76−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
77−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile
78−
79−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
80− => [(Either P.RebuildPolicy FilePath, String)]
81− -> [(FilePath, P.ForeignJS)]
82− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName (FilePath, P.ForeignJS))
83−parseInputs modules foreigns =
84− (,) <$> P.parseModulesFromFiles (either (const "") id) modules
85− <*> P.parseForeignModulesFromFiles foreigns
86−
87−inputFile :: Parser FilePath
88−inputFile = strArgument $
89− metavar "FILE"
90− <> help "The input .purs file(s)"
91−
92−inputForeignFile :: Parser FilePath
93−inputForeignFile = strOption $
94− short 'f'
95− <> long "ffi"
96− <> help "The input .js file(s) providing foreign import implementations"
97−
98−outputDirectory :: Parser FilePath
99−outputDirectory = strOption $
100− short 'o'
101− <> long "output"
102− <> Opts.value "output"
103− <> showDefault
104− <> help "The output directory"
105−
106−noTco :: Parser Bool
107−noTco = switch $
108− long "no-tco"
109− <> help "Disable tail call optimizations"
110−
111−noPrelude :: Parser Bool
112−noPrelude = switch $
113− long "no-prelude"
114− <> help "Omit the automatic Prelude import"
115−
116−noMagicDo :: Parser Bool
117−noMagicDo = switch $
118− long "no-magic-do"
119− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
120−
121−noOpts :: Parser Bool
122−noOpts = switch $
123− long "no-opts"
124− <> help "Skip the optimization phase."
125−
126−comments :: Parser Bool
127−comments = switch $
128− short 'c'
129− <> long "comments"
130− <> help "Include comments in the generated code."
131−
132−verboseErrors :: Parser Bool
133−verboseErrors = switch $
134− short 'v'
135− <> long "verbose-errors"
136− <> help "Display verbose error messages"
137−
138−noPrefix :: Parser Bool
139−noPrefix = switch $
140− short 'p'
141− <> long "no-prefix"
142− <> help "Do not include comment header"
143−
144−
145−options :: Parser (P.Options P.Make)
146−options = P.Options <$> noPrelude
147− <*> noTco
148− <*> noMagicDo
149− <*> pure Nothing
150− <*> noOpts
151− <*> verboseErrors
152− <*> (not <$> comments)
153− <*> pure P.MakeOptions
154−
155−pscMakeOptions :: Parser PSCMakeOptions
156−pscMakeOptions = PSCMakeOptions <$> many inputFile
157− <*> many inputForeignFile
158− <*> outputDirectory
159− <*> options
160− <*> (not <$> noPrefix)
161−
162−main :: IO ()
163−main = execParser opts >>= compile
164− where
165− opts = info (version <*> helper <*> pscMakeOptions) infoModList
166− infoModList = fullDesc <> headerInfo <> footerInfo
167− headerInfo = header "psc-make - Compiles PureScript to Javascript"
168− footerInfo = footer $ "psc-make " ++ showVersion Paths.version
169−
170− version :: Parser (a -> a)
171− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psc-make/Make.hsdeleted−136
@@ -1,136 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Make
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DataKinds #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18−{-# LANGUAGE TupleSections #-}
19−
20−module Make
21− ( Make(..)
22− , runMake
23− , buildMakeActions
24− ) where
25−
26−import Control.Applicative
27−import Control.Monad
28−import Control.Monad.Error.Class (MonadError(..))
29−import Control.Monad.Trans.Except
30−import Control.Monad.Reader
31−import Control.Monad.Writer
32−
33−import Data.Maybe (fromMaybe)
34−import Data.Time.Clock
35−import Data.Traversable (traverse)
36−import Data.Version (showVersion)
37−import qualified Data.Map as M
38−
39−import System.Directory
40− (doesFileExist, getModificationTime, createDirectoryIfMissing)
41−import System.FilePath ((</>), takeDirectory)
42−import System.IO.Error (tryIOError)
43−
44−import qualified Language.PureScript as P
45−import qualified Language.PureScript.CodeGen.JS as J
46−import qualified Language.PureScript.CoreFn as CF
47−import qualified Paths_purescript as Paths
48−
49−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
50− deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))
51−
52−runMake :: P.Options P.Make -> Make a -> IO (Either P.MultipleErrors (a, P.MultipleErrors))
53−runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake
54−
55−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
56−makeIO f io = do
57− e <- liftIO $ tryIOError io
58− either (throwError . P.singleError . f) return e
59−
60−-- Traverse (Either e) instance (base 4.7)
61−traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
62−traverseEither _ (Left x) = pure (Left x)
63−traverseEither f (Right y) = Right <$> f y
64−
65−buildMakeActions :: FilePath
66− -> M.Map P.ModuleName (Either P.RebuildPolicy String)
67− -> M.Map P.ModuleName (FilePath, P.ForeignJS)
68− -> Bool
69− -> P.MakeActions Make
70−buildMakeActions outputDir filePathMap foreigns usePrefix =
71− P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
72− where
73−
74− getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
75− getInputTimestamp mn = do
76− let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
77− traverseEither getTimestamp path
78−
79− getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
80− getOutputTimestamp mn = do
81− let filePath = P.runModuleName mn
82− jsFile = outputDir </> filePath </> "index.js"
83− externsFile = outputDir </> filePath </> "externs.purs"
84− min <$> getTimestamp jsFile <*> getTimestamp externsFile
85−
86− readExterns :: P.ModuleName -> Make (FilePath, String)
87− readExterns mn = do
88− let path = outputDir </> P.runModuleName mn </> "externs.purs"
89− (path, ) <$> readTextFile path
90−
91− codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()
92− codegen m _ nextVar exts = do
93− let mn = CF.moduleName m
94− foreignInclude <- case mn `M.lookup` foreigns of
95− Just (path, _)
96− | not $ requiresForeign m -> do
97− tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
98− return Nothing
99− | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
100− Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn
101− | otherwise -> return Nothing
102− pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
103− let filePath = P.runModuleName mn
104− jsFile = outputDir </> filePath </> "index.js"
105− externsFile = outputDir </> filePath </> "externs.purs"
106− foreignFile = outputDir </> filePath </> "foreign.js"
107− prefix = ["Generated by psc-make version " ++ showVersion Paths.version | usePrefix]
108− js = unlines $ map ("// " ++) prefix ++ [pjs]
109− writeTextFile jsFile js
110− maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns
111− writeTextFile externsFile exts
112−
113− requiresForeign :: CF.Module a -> Bool
114− requiresForeign = not . null . CF.moduleForeign
115−
116− getTimestamp :: FilePath -> Make (Maybe UTCTime)
117− getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
118− exists <- doesFileExist path
119− traverse (const $ getModificationTime path) $ guard exists
120−
121− readTextFile :: FilePath -> Make String
122− readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ do
123− putStrLn $ "Reading " ++ path
124− readFile path
125−
126− writeTextFile :: FilePath -> String -> Make ()
127− writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
128− mkdirp path
129− putStrLn $ "Writing " ++ path
130− writeFile path text
131− where
132− mkdirp :: FilePath -> IO ()
133− mkdirp = createDirectoryIfMissing True . takeDirectory
134−
135− progress :: String -> Make ()
136− progress = liftIO . putStrLn
psc-publish/BoxesHelpers.hsdeleted−38
@@ -1,38 +0,0 @@
1−module BoxesHelpers
2− ( Boxes.Box
3− , Boxes.nullBox
4− , module BoxesHelpers
5− ) where
6−
7−import System.IO (hPutStr, stderr)
8−import qualified Text.PrettyPrint.Boxes as Boxes
9−
10−width :: Int
11−width = 79
12−
13−indentWidth :: Int
14−indentWidth = 2
15−
16−para :: String -> Boxes.Box
17−para = Boxes.para Boxes.left width
18−
19−indented :: Boxes.Box -> Boxes.Box
20−indented b = Boxes.hcat Boxes.left [Boxes.emptyBox 1 indentWidth, b]
21−
22−successivelyIndented :: [String] -> Boxes.Box
23−successivelyIndented [] =
24− Boxes.nullBox
25−successivelyIndented (x:xs) =
26− Boxes.vcat Boxes.left [para x, indented (successivelyIndented xs)]
27−
28−vcat :: [Boxes.Box] -> Boxes.Box
29−vcat = Boxes.vcat Boxes.left
30−
31−spacer :: Boxes.Box
32−spacer = Boxes.emptyBox 1 1
33−
34−bulletedList :: (a -> String) -> [a] -> [Boxes.Box]
35−bulletedList f = map (indented . para . ("* " ++) . f)
36−
37−printToStderr :: Boxes.Box -> IO ()
38−printToStderr = hPutStr stderr . Boxes.render
psc-publish/ErrorsWarnings.hsdeleted−317
@@ -1,317 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module ErrorsWarnings where
4−
5−import Data.Aeson.BetterErrors
6−import Data.Version
7−import Data.Maybe
8−import Data.List (intersperse)
9−import Data.List.NonEmpty (NonEmpty(..))
10−import qualified Data.List.NonEmpty as NonEmpty
11−
12−import qualified Data.Text as T
13−
14−import Control.Exception (IOException)
15−import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName)
16−import qualified Web.Bower.PackageMeta as Bower
17−
18−import qualified Language.PureScript as P
19−import qualified Language.PureScript.Docs as D
20−
21−import BoxesHelpers
22−
23−-- | An error which meant that it was not possible to retrieve metadata for a
24−-- package.
25−data PackageError
26− = UserError UserError
27− | InternalError InternalError
28− | OtherError OtherError
29− deriving (Show)
30−
31−data PackageWarning
32− = ResolutionNotVersion PackageName
33− | UndeclaredDependency PackageName
34− deriving (Show)
35−
36−-- | An error that should be fixed by the user.
37−data UserError
38− = BowerJSONNotFound
39− | CouldntParseBowerJSON (ParseError BowerError)
40− | BowerJSONNameMissing
41− | TagMustBeCheckedOut
42− | AmbiguousVersions [Version] -- Invariant: should contain at least two elements
43− | BadRepositoryField RepositoryFieldError
44− | MissingDependencies (NonEmpty PackageName)
45− | ParseAndDesugarError D.ParseDesugarError
46− deriving (Show)
47−
48−data RepositoryFieldError
49− = RepositoryFieldMissing
50− | BadRepositoryType String
51− | NotOnGithub
52− deriving (Show)
53−
54−-- | An error that probably indicates a bug in this module.
55−data InternalError
56− = JSONError JSONSource (ParseError BowerError)
57− deriving (Show)
58−
59−data JSONSource
60− = FromFile FilePath
61− | FromBowerList
62− deriving (Show)
63−
64−data OtherError
65− = ProcessFailed String [String] IOException
66− | IOExceptionThrown IOException
67− deriving (Show)
68−
69−printError :: PackageError -> IO ()
70−printError = printToStderr . renderError
71−
72−renderError :: PackageError -> Box
73−renderError err =
74− case err of
75− UserError e ->
76− vcat
77− [ para (concat
78− [ "There is a problem with your package, which meant that "
79− , "it could not be published."
80− ])
81− , para "Details:"
82− , indented (displayUserError e)
83− ]
84− InternalError e ->
85− vcat
86− [ para "Internal error: this is probably a bug. Please report it:"
87− , indented (para "https://github.com/purescript/purescript/issues/new")
88− , spacer
89− , para "Details:"
90− , successivelyIndented (displayInternalError e)
91− ]
92− OtherError e ->
93− vcat
94− [ para "An error occurred, and your package could not be published."
95− , para "Details:"
96− , indented (displayOtherError e)
97− ]
98−
99−displayUserError :: UserError -> Box
100−displayUserError e = case e of
101− BowerJSONNotFound ->
102− para (concat
103− [ "The bower.json file was not found. Please create one, or run "
104− , "`pulp init`."
105− ])
106− CouldntParseBowerJSON err ->
107− vcat
108− [ successivelyIndented
109− [ "The bower.json file could not be parsed as JSON:"
110− , "aeson reported: " ++ show err
111− ]
112− , para "Please ensure that your bower.json file is valid JSON."
113− ]
114− BowerJSONNameMissing ->
115− vcat
116− [ successivelyIndented
117− [ "In bower.json:"
118− , "the \"name\" key was not found."
119− ]
120− , para "Please give your package a name first."
121− ]
122− TagMustBeCheckedOut ->
123− vcat
124− [ para (concat
125− [ "psc-publish requires a tagged version to be checked out in "
126− , "order to build documentation, and no suitable tag was found. "
127− , "Please check out a previously tagged version, or tag a new "
128− , "version."
129− ])
130− , spacer
131− , para "Note: tagged versions must be in one of the following forms:"
132− , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
133− , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")
134− ]
135− AmbiguousVersions vs ->
136− vcat $
137− [ para (concat
138− [ "The currently checked out commit seems to have been tagged with "
139− , "more than 1 version, and I don't know which one should be used. "
140− , "Please either delete some of the tags, or create a new commit "
141− , "to tag the desired verson with."
142− ])
143− , spacer
144− , para "Tags for the currently checked out commit:"
145− ] ++ bulletedList showVersion vs
146− BadRepositoryField err ->
147− displayRepositoryError err
148− MissingDependencies pkgs ->
149− let singular = NonEmpty.length pkgs == 1
150− pl a b = if singular then b else a
151− do_ = pl "do" "does"
152− dependencies = pl "dependencies" "dependency"
153− them = pl "them" "it"
154− in vcat $
155− [ para (concat
156− [ "The following Bower ", dependencies, " ", do_, " not appear to be "
157− , "installed:"
158− ])
159− ] ++
160− bulletedList runPackageName (NonEmpty.toList pkgs)
161− ++
162− [ spacer
163− , para (concat
164− [ "Please install ", them, " first, by running `bower install`."
165− ])
166− ]
167− ParseAndDesugarError (D.ParseError err) ->
168− vcat
169− [ para "Parse error:"
170− , indented (para (show err))
171− ]
172− ParseAndDesugarError (D.SortModulesError err) ->
173− vcat
174− [ para "Error in sortModules:"
175− , indented (para (P.prettyPrintMultipleErrors False err))
176− ]
177− ParseAndDesugarError (D.DesugarError err) ->
178− vcat
179− [ para "Error while desugaring:"
180− , indented (para (P.prettyPrintMultipleErrors False err))
181− ]
182−
183−displayRepositoryError :: RepositoryFieldError -> Box
184−displayRepositoryError err = case err of
185− RepositoryFieldMissing ->
186− vcat
187− [ para (concat
188− [ "The 'repository' field is not present in your bower.json file. "
189− , "Without this information, Pursuit would not be able to generate "
190− , "source links in your package's documentation. Please add one - like "
191− , "this, for example:"
192− ])
193− , spacer
194− , indented (vcat
195− [ para "\"repository\": {"
196− , indented (para "\"type\": \"git\",")
197− , indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")
198− , para "}"
199− ]
200− )
201− ]
202− BadRepositoryType ty ->
203− para (concat
204− [ "In your bower.json file, the repository type is currently listed as "
205− , "\"" ++ ty ++ "\". Currently, only git repositories are supported. "
206− , "Please publish your code in a git repository, and then update the "
207− , "repository type in your bower.json file to \"git\"."
208− ])
209− NotOnGithub ->
210− vcat
211− [ para (concat
212− [ "The repository url in your bower.json file does not point to a "
213− , "GitHub repository. Currently, Pursuit does not support packages "
214− , "which are not hosted on GitHub."
215− ])
216− , spacer
217− , para (concat
218− [ "Please update your bower.json file to point to a GitHub repository. "
219− , "Alternatively, if you would prefer not to host your package on "
220− , "GitHub, please open an issue:"
221− ])
222− , indented (para "https://github.com/purescript/purescript/issues/new")
223− ]
224−
225−displayInternalError :: InternalError -> [String]
226−displayInternalError e = case e of
227− JSONError src r ->
228− [ "Error in JSON " ++ displayJSONSource src ++ ":"
229− , T.unpack (Bower.displayError r)
230− ]
231−
232−displayJSONSource :: JSONSource -> String
233−displayJSONSource s = case s of
234− FromFile fp ->
235− "in file " ++ show fp
236− FromBowerList ->
237− "in the output of `bower list --json --offline`"
238−
239−displayOtherError :: OtherError -> Box
240−displayOtherError e = case e of
241− ProcessFailed prog args exc ->
242− successivelyIndented
243− [ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"
244− , show exc
245− ]
246− IOExceptionThrown exc ->
247− successivelyIndented
248− [ "An IO exception occurred:", show exc ]
249−
250−renderWarnings :: [PackageWarning] -> Box
251−renderWarnings =
252− collectWarnings
253− [ (getResolutionNotVersion, warnResolutionNotVersions)
254− , (getUndeclaredDependency, warnUndeclaredDependencies)
255− ]
256− where
257− collectWarnings patterns warns =
258− let boxes = mapMaybe (collectWarnings' warns) patterns
259− in vcat
260− [ para "Warnings:"
261− , indented (vcat (intersperse spacer boxes))
262− ]
263−
264− getResolutionNotVersion (ResolutionNotVersion n) = Just n
265− getResolutionNotVersion _ = Nothing
266−
267− getUndeclaredDependency (UndeclaredDependency n) = Just n
268− getUndeclaredDependency _ = Nothing
269−
270−collectWarnings' :: [PackageWarning] -> ((PackageWarning -> Maybe a), (NonEmpty a -> Box)) -> Maybe Box
271−collectWarnings' warns (pattern, render) =
272− case mapMaybe pattern warns of
273− [] -> Nothing
274− (x:xs) -> Just (render (x :| xs))
275−
276−warnResolutionNotVersions :: NonEmpty PackageName -> Box
277−warnResolutionNotVersions pkgNames =
278− let singular = NonEmpty.length pkgNames == 1
279− pl a b = if singular then b else a
280−
281− packages = pl "packages" "package"
282− were = pl "were" "was"
283− anyOfThese = pl "any of these" "this"
284− these = pl "these" "this"
285− in vcat $
286− [ para (concat
287− ["The following ", packages, " ", were, " not resolved to a version:"])
288− ] ++
289− bulletedList runPackageName (NonEmpty.toList pkgNames)
290− ++
291− [ spacer
292− , para (concat
293− ["Links to types in ", anyOfThese, " ", packages, " will not work. In "
294− , "order to make links work, edit your bower.json to specify a version"
295− , " or a version range for ", these, " ", packages, ", and rerun "
296− , "`bower install`."
297− ])
298− ]
299−
300−warnUndeclaredDependencies :: NonEmpty PackageName -> Box
301−warnUndeclaredDependencies pkgNames =
302− let singular = NonEmpty.length pkgNames == 1
303− pl a b = if singular then b else a
304−
305− packages = pl "packages" "package"
306− are = pl "are" "is"
307− dependencies = pl "dependencies" "a dependency"
308− in vcat $
309− [ para (concat
310− [ "The following Bower ", packages, " ", are, " installed, but not "
311− , "declared as ", dependencies, " in your bower.json file:"
312− ])
313− ] ++
314− bulletedList runPackageName (NonEmpty.toList pkgNames)
315−
316−printWarnings :: [PackageWarning] -> IO ()
317−printWarnings = printToStderr . renderWarnings
psc-publish/Main.hsdeleted−280
@@ -1,280 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards #-}
3−{-# LANGUAGE TupleSections #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−
6−import Prelude hiding (userError)
7−
8−import Data.Maybe
9−import Data.Char (isSpace)
10−import Data.String (fromString)
11−import Data.List (stripPrefix, isSuffixOf, (\\))
12−import Data.List.Split (splitOn)
13−import Data.List.NonEmpty (NonEmpty(..))
14−import Data.Version
15−import Safe (headMay)
16−
17−import qualified Data.ByteString.Lazy.Char8 as BL
18−import qualified Data.Text as T
19−
20−import qualified Data.Aeson as A
21−import Data.Aeson.BetterErrors
22−
23−import Control.Applicative
24−import Control.Category ((>>>))
25−import Control.Arrow ((***))
26−import Control.Exception (catch, try)
27−import Control.Monad.Trans.Except
28−import Control.Monad.Error.Class (MonadError(..))
29−import Control.Monad.Writer
30−
31−import System.Directory (doesFileExist)
32−import System.Process (readProcess)
33−import System.Exit (exitFailure)
34−import qualified System.FilePath.Glob as Glob
35−
36−import Web.Bower.PackageMeta (PackageMeta(..), BowerError(..), PackageName,
37− runPackageName, parsePackageName, Repository(..))
38−import qualified Web.Bower.PackageMeta as Bower
39−
40−import qualified Language.PureScript.Docs as D
41−import Utils
42−import ErrorsWarnings
43−
44−main :: IO ()
45−main = do
46− pkg <- preparePackage
47− BL.putStrLn (A.encode pkg)
48−
49−-- | Attempt to retrieve package metadata from the current directory.
50−-- Calls exitFailure if no package metadata could be retrieved.
51−preparePackage :: IO D.UploadedPackage
52−preparePackage =
53− runPrepareM preparePackage'
54− >>= either (\e -> printError e >> exitFailure)
55− handleWarnings
56− where
57− handleWarnings (result, warns) = do
58− printWarnings warns
59− return result
60−
61−newtype PrepareM a =
62− PrepareM { unPrepareM :: WriterT [PackageWarning] (ExceptT PackageError IO) a }
63− deriving (Functor, Applicative, Monad,
64− MonadWriter [PackageWarning],
65− MonadError PackageError)
66−
67−-- This MonadIO instance ensures that IO errors don't crash the program.
68−instance MonadIO PrepareM where
69− liftIO act =
70− lift' (try act) >>= either (otherError . IOExceptionThrown) return
71− where
72− lift' :: IO a -> PrepareM a
73− lift' = PrepareM . lift . lift
74−
75−runPrepareM :: PrepareM a -> IO (Either PackageError (a, [PackageWarning]))
76−runPrepareM = runExceptT . runWriterT . unPrepareM
77−
78−warn :: PackageWarning -> PrepareM ()
79−warn w = tell [w]
80−
81−userError :: UserError -> PrepareM a
82−userError = throwError . UserError
83−
84−internalError :: InternalError -> PrepareM a
85−internalError = throwError . InternalError
86−
87−otherError :: OtherError -> PrepareM a
88−otherError = throwError . OtherError
89−
90−catchLeft :: Applicative f => Either a b -> (a -> f b) -> f b
91−catchLeft a f = either f pure a
92−
93−preparePackage' :: PrepareM D.UploadedPackage
94−preparePackage' = do
95− exists <- liftIO (doesFileExist "bower.json")
96− unless exists (userError BowerJSONNotFound)
97−
98− pkgMeta <- liftIO (Bower.decodeFile "bower.json")
99− >>= flip catchLeft (userError . CouldntParseBowerJSON)
100− (pkgVersionTag, pkgVersion) <- getVersionFromGitTag
101− pkgGithub <- getBowerInfo pkgMeta
102− (pkgBookmarks, pkgModules) <- getModulesAndBookmarks
103−
104− let declaredDeps = map fst (bowerDependencies pkgMeta ++
105− bowerDevDependencies pkgMeta)
106− pkgResolvedDependencies <- getResolvedDependencies declaredDeps
107−
108− let pkgUploader = D.NotYetKnown
109−
110− return D.Package{..}
111−
112−getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.RenderedModule])
113−getModulesAndBookmarks = do
114− (inputFiles, depsFiles) <- liftIO getInputAndDepsFiles
115− liftIO (D.parseAndDesugar inputFiles depsFiles renderModules)
116− >>= either (userError . ParseAndDesugarError) return
117− where
118− renderModules bookmarks modules =
119− return (bookmarks, map D.renderModule modules)
120−
121−getVersionFromGitTag :: PrepareM (String, Version)
122−getVersionFromGitTag = do
123− out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""
124− let vs = map trimWhitespace (lines out)
125− case mapMaybe parseMay vs of
126− [] -> userError TagMustBeCheckedOut
127− [x] -> return x
128− xs -> userError (AmbiguousVersions (map snd xs))
129− where
130− trimWhitespace =
131− dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
132− parseMay str =
133− (str,) <$> D.parseVersion' (dropPrefix "v" str)
134− dropPrefix prefix str =
135− fromMaybe str (stripPrefix prefix str)
136−
137−getBowerInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)
138−getBowerInfo = either (userError . BadRepositoryField) return . tryExtract
139− where
140− tryExtract pkgMeta =
141− case bowerRepository pkgMeta of
142− Nothing -> Left RepositoryFieldMissing
143− Just Repository{..} -> do
144− unless (repositoryType == "git")
145− (Left (BadRepositoryType repositoryType))
146− maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)
147−
148−extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)
149−extractGithub =
150− stripPrefix "git://github.com/"
151− >>> fmap (splitOn "/")
152− >=> takeTwo
153− >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))
154−
155− where
156− takeTwo :: [a] -> Maybe (a, a)
157− takeTwo [x, y] = Just (x, y)
158− takeTwo _ = Nothing
159−
160− dropDotGit :: String -> String
161− dropDotGit str
162− | ".git" `isSuffixOf` str = take (length str - 4) str
163− | otherwise = str
164−
165−readProcess' :: String -> [String] -> String -> PrepareM String
166−readProcess' prog args stdin = do
167− out <- liftIO (catch (Right <$> readProcess prog args stdin)
168− (return . Left))
169− either (otherError . ProcessFailed prog args) return out
170−
171−data DependencyStatus
172− = Missing
173− | ResolvedOther String
174− -- ^ Resolved, but to something other than a version. The String argument
175− -- is the resolution type. The values it can take that I'm aware of are
176− -- "commit" and "branch".
177− | ResolvedVersion String
178− -- ^ Resolved to a version. The String argument is the resolution tag (eg,
179− -- "v0.1.0").
180− deriving (Show, Eq)
181−
182−-- Go through all bower dependencies which contain purescript code, and
183−-- extract their versions.
184−--
185−-- In the case where a bower dependency is taken from a particular version,
186−-- that's easy; take that version. In any other case (eg, a branch, or a commit
187−-- sha) we print a warning that documentation links will not work, and avoid
188−-- linking to documentation for any types from that package.
189−--
190−-- The rationale for this is: people will prefer to use a released version
191−-- where possible. If they are not using a released version, then this is
192−-- probably for a reason. However, docs are only ever available for released
193−-- versions. Therefore there will probably be no version of the docs which is
194−-- appropriate to link to, and we should omit links.
195−getResolvedDependencies :: [PackageName] -> PrepareM [(PackageName, Version)]
196−getResolvedDependencies declaredDeps = do
197− depsBS <- fromString <$> readProcess' "bower" ["list", "--json", "--offline"] ""
198−
199− deps <- catchLeft (parse asBowerResolvedDependencies depsBS)
200− (internalError . JSONError FromBowerList)
201−
202− warnUndeclared declaredDeps (map fst deps)
203− handleDeps deps
204−
205− where
206− asBowerResolvedDependencies ::
207− Parse BowerError [(PackageName, DependencyStatus)]
208− asBowerResolvedDependencies =
209− key "dependencies"
210− (eachInObjectWithKey (parsePackageName . T.unpack) asDependencyStatus)
211−
212−asDependencyStatus :: Parse e DependencyStatus
213−asDependencyStatus = do
214− isMissing <- keyOrDefault "missing" False asBool
215− if isMissing
216− then
217− return Missing
218− else
219− key "pkgMeta" $
220− key "_resolution" $ do
221− type_ <- key "type" asString
222− case type_ of
223− "version" -> ResolvedVersion <$> key "tag" asString
224− other -> return (ResolvedOther other)
225−
226−warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()
227−warnUndeclared declared actual =
228− mapM_ (warn . UndeclaredDependency) (actual \\ declared)
229−
230−handleDeps ::
231− [(PackageName, DependencyStatus)] -> PrepareM [(PackageName, Version)]
232−handleDeps deps = do
233− let (missing, notVersion, installed) = partitionDeps deps
234− case missing of
235− (x:xs) ->
236− userError (MissingDependencies (x :| xs))
237− [] -> do
238− mapM_ (warn . ResolutionNotVersion . fst) notVersion
239− let withVersions = mapMaybe tryExtractVersion installed
240− filterM (liftIO . isPureScript . bowerDir . fst) withVersions
241−
242− where
243− partitionDeps = foldr go ([], [], [])
244− go (pkgName, d) (ms, os, is) =
245− case d of
246− Missing -> (pkgName : ms, os, is)
247− ResolvedOther o -> (ms, (pkgName, o) : os, is)
248− ResolvedVersion v -> (ms, os, (pkgName, v) : is)
249−
250− bowerDir pkgName = "bower_components/" ++ runPackageName pkgName
251−
252−tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)
253−tryExtractVersion (pkgName, tag) =
254− let tag' = fromMaybe tag (stripPrefix "v" tag)
255− in (pkgName,) <$> D.parseVersion' tag'
256−
257−-- | Returns whether it looks like there is a purescript package checked out
258−-- in the given directory.
259−isPureScript :: FilePath -> IO Bool
260−isPureScript dir = do
261− files <- Glob.globDir1 purescriptSourceFiles dir
262− return (not (null files))
263−
264−getInputAndDepsFiles :: IO ([FilePath], [(PackageName, FilePath)])
265−getInputAndDepsFiles = do
266− inputFiles <- globRelative purescriptSourceFiles
267− depsFiles' <- globRelative purescriptDepsFiles
268− return (inputFiles, mapMaybe withPackageName depsFiles')
269−
270−withPackageName :: FilePath -> Maybe (PackageName, FilePath)
271−withPackageName fp = (,fp) <$> getPackageName fp
272−
273−getPackageName :: FilePath -> Maybe PackageName
274−getPackageName fp = do
275− let xs = splitOn "/" fp
276− ys <- stripPrefix ["bower_components"] xs
277− y <- headMay ys
278− case Bower.mkPackageName y of
279− Right name -> Just name
280− Left _ -> Nothing
psc-publish/Utils.hsdeleted−22
@@ -1,22 +0,0 @@
1−
2−module Utils where
3−
4−import Data.List
5−import Data.Maybe
6−import System.Directory
7−import qualified System.FilePath.Glob as Glob
8−
9−-- | Glob relative to the current directory, and produce relative pathnames.
10−globRelative :: Glob.Pattern -> IO [FilePath]
11−globRelative pat = do
12− currentDir <- getCurrentDirectory
13− filesAbsolute <- Glob.globDir1 pat currentDir
14− return (mapMaybe (stripPrefix (currentDir ++ "/")) filesAbsolute)
15−
16−-- | Glob pattern for PureScript source files.
17−purescriptSourceFiles :: Glob.Pattern
18−purescriptSourceFiles = Glob.compile "src/**/*.purs"
19−
20−-- | Glob pattern for PureScript dependency files.
21−purescriptDepsFiles :: Glob.Pattern
22−purescriptDepsFiles = Glob.compile "bower_components/*/src/**/*.purs"
psc-publish/tests/Test.hsdeleted−76
@@ -1,76 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2−{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3−
4−-- | To run these tests:
5−--
6−-- * `cabal repl psc-publish`
7−-- * `:l psc-publish/tests/Test.hs`
8−-- * `test`
9−
10−module Test where
11−
12−import Control.Monad
13−import Control.Applicative
14−import System.Process
15−import System.Directory
16−import qualified Data.ByteString.Lazy as BL
17−import Data.ByteString.Lazy (ByteString)
18−import qualified Data.Aeson as A
19−import Data.Aeson.BetterErrors
20−
21−import Main
22−import Language.PureScript.Docs
23−
24−packageName = "purescript-integers"
25−packageUrl = "https://github.com/purescript/" ++ packageName
26−packageDir = "tmp/" ++ packageName
27−
28−pushd :: FilePath -> IO a -> IO a
29−pushd dir act = do
30− original <- getCurrentDirectory
31− setCurrentDirectory dir
32− result <- act
33− setCurrentDirectory original
34− return result
35−
36−clonePackage :: IO ()
37−clonePackage = do
38− createDirectoryIfMissing True packageDir
39− pushd packageDir $ do
40− exists <- doesDirectoryExist ".git"
41− unless exists $ do
42− putStrLn ("Cloning " ++ packageName ++ " into " ++ packageDir ++ "...")
43− readProcess "git" ["clone", packageUrl, "."] "" >>= putStr
44−
45−bowerInstall :: IO ()
46−bowerInstall = do
47− pushd packageDir $ do
48− readProcess "bower" ["install"] "" >>= putStr
49−
50−getPackage :: IO UploadedPackage
51−getPackage = do
52− clonePackage
53− bowerInstall
54− pushd packageDir preparePackage
55−
56−data TestResult
57− = ParseFailed (ParseError UploadedPackageError)
58− | Mismatch ByteString ByteString -- ^ encoding before, encoding after
59− | Pass ByteString
60− deriving (Show)
61−
62−-- | Test JSON encoding/decoding; parse the package, roundtrip to/from JSON,
63−-- and check we get the same string.
64−test :: IO TestResult
65−test = roundTrip <$> getPackage
66−
67−roundTrip :: UploadedPackage -> TestResult
68−roundTrip pkg =
69− let before = A.encode pkg
70− in case parse asUploadedPackage before of
71− Left err -> ParseFailed err
72− Right parsed -> do
73− let after = A.encode parsed
74− if before == after
75− then Pass before
76− else Mismatch before after
psc/Main.hsdeleted−281
@@ -1,281 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DataKinds #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE RecordWildCards #-}
18−{-# LANGUAGE ScopedTypeVariables #-}
19−{-# LANGUAGE TupleSections #-}
20−
21−module Main where
22−
23−import Control.Applicative
24−import Control.Monad
25−import Control.Monad.Error.Class (MonadError(..))
26−import Control.Monad.Reader
27−import Control.Monad.Supply (evalSupplyT)
28−import Control.Monad.Supply.Class (MonadSupply())
29−import Control.Monad.Writer
30−
31−import Data.Maybe (fromMaybe)
32−import Data.Version (showVersion)
33−
34−import Options.Applicative as Opts
35−
36−import System.Directory (createDirectoryIfMissing)
37−import System.Exit (exitSuccess, exitFailure)
38−import System.FilePath (takeDirectory)
39−import System.IO (hPutStrLn, stderr)
40−
41−import qualified Data.Map as M
42−import qualified Language.PureScript as P
43−import qualified Language.PureScript.CodeGen.JS as J
44−import qualified Language.PureScript.Constants as C
45−import qualified Language.PureScript.CoreFn as CF
46−import qualified Paths_purescript as Paths
47−
48−data PSCOptions = PSCOptions
49− { pscInput :: [FilePath]
50− , pscForeignInput :: [FilePath]
51− , pscOpts :: P.Options P.Compile
52− , pscStdIn :: Bool
53− , pscOutput :: Maybe FilePath
54− , pscExterns :: Maybe FilePath
55− , pscUsePrefix :: Bool
56− }
57−
58−data InputOptions = InputOptions
59− { ioNoPrelude :: Bool
60− , ioUseStdIn :: Bool
61− , ioInputFiles :: [FilePath]
62− }
63−
64−readInput :: InputOptions -> IO [(Maybe FilePath, String)]
65−readInput InputOptions{..}
66− | ioUseStdIn = return . (Nothing ,) <$> getContents
67− | otherwise = forM ioInputFiles $ \inFile -> (Just inFile, ) <$> readFile inFile
68−
69−type PSC = ReaderT (P.Options P.Compile) (WriterT P.MultipleErrors (Either P.MultipleErrors))
70−
71−runPSC :: P.Options P.Compile -> PSC a -> Either P.MultipleErrors (a, P.MultipleErrors)
72−runPSC opts rwe = runWriterT (runReaderT rwe opts)
73−
74−compile :: PSCOptions -> IO ()
75−compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
76− let prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
77− moduleFiles <- readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
78− foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
79− case runWriterT (parseInputs moduleFiles foreignFiles) of
80− Left errs -> do
81− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
82− exitFailure
83− Right ((ms, foreigns), warnings) -> do
84− when (P.nonEmpty warnings) $
85− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
86− case runPSC opts (compileJS ms foreigns prefix) of
87− Left errs -> do
88− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
89− exitFailure
90− Right ((js, exts), warnings') -> do
91− when (P.nonEmpty warnings') $
92− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
93− case output of
94− Just path -> mkdirp path >> writeFile path js
95− Nothing -> putStrLn js
96− case externs of
97− Just path -> mkdirp path >> writeFile path exts
98− Nothing -> return ()
99− exitSuccess
100−
101−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
102− => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([P.Module], M.Map P.ModuleName (FilePath, P.ForeignJS))
103−parseInputs modules foreigns =
104− (,) <$> (map snd <$> P.parseModulesFromFiles (fromMaybe "") modules)
105− <*> P.parseForeignModulesFromFiles foreigns
106−
107−compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
108− => [P.Module] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> [String] -> m (String, String)
109−compileJS ms foreigns prefix = do
110− (modulesToCodeGen, env, nextVar, exts) <- P.compile ms
111− js <- concat <$> evalSupplyT nextVar (P.parU modulesToCodeGen codegenModule)
112− js' <- generateMain env js
113− let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
114− return (pjs, exts)
115−
116− where
117−
118− codegenModule :: (Functor n, Applicative n, MonadError P.MultipleErrors n, MonadWriter P.MultipleErrors n, MonadReader (P.Options P.Compile) n, MonadSupply n)
119− => CF.Module CF.Ann -> n [J.JS]
120− codegenModule m =
121− let requiresForeign = not $ null (CF.moduleForeign m)
122− mn = CF.moduleName m
123− in case mn `M.lookup` foreigns of
124− Just (path, js)
125− | not requiresForeign -> do
126− tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
127− J.moduleToJs m Nothing
128− | otherwise -> J.moduleToJs m $ Just $
129− J.JSApp (J.JSFunction Nothing [] $
130− J.JSBlock [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])
131− , J.JSRaw js
132− , J.JSReturn (J.JSVar "exports")
133− ]) []
134− Nothing | requiresForeign -> throwError . P.errorMessage $ P.MissingFFIModule mn
135− | otherwise -> J.moduleToJs m Nothing
136−
137− generateMain :: P.Environment -> [J.JS] -> m [J.JS]
138− generateMain env js = do
139− mainName <- asks P.optionsMain
140− additional <- asks P.optionsAdditional
141− case P.moduleNameFromString <$> mainName of
142− Just mmi -> do
143− when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
144− throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
145− return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
146− _ -> return js
147−
148−mkdirp :: FilePath -> IO ()
149−mkdirp = createDirectoryIfMissing True . takeDirectory
150−
151−codeGenModule :: Parser String
152−codeGenModule = strOption $
153− long "codegen"
154− <> help "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times."
155−
156−dceModule :: Parser String
157−dceModule = strOption $
158− short 'm'
159− <> long "module"
160− <> help "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."
161−
162−browserNamespace :: Parser String
163−browserNamespace = strOption $
164− long "browser-namespace"
165− <> Opts.value "PS"
166− <> showDefault
167− <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
168−
169−verboseErrors :: Parser Bool
170−verboseErrors = switch $
171− short 'v'
172− <> long "verbose-errors"
173− <> help "Display verbose error messages"
174−
175−noOpts :: Parser Bool
176−noOpts = switch $
177− long "no-opts"
178− <> help "Skip the optimization phase."
179−
180−runMain :: Parser (Maybe String)
181−runMain = optional $ noArgs <|> withArgs
182− where
183− defaultVal = "Main"
184− noArgs = flag' defaultVal (long "main")
185− withArgs = strOption $
186− long "main"
187− <> help (concat [
188− "Generate code to run the main method in the specified module. ",
189− "(no argument: \"", defaultVal, "\")"
190− ])
191−
192−noMagicDo :: Parser Bool
193−noMagicDo = switch $
194− long "no-magic-do"
195− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
196−
197−noTco :: Parser Bool
198−noTco = switch $
199− long "no-tco"
200− <> help "Disable tail call optimizations"
201−
202−noPrelude :: Parser Bool
203−noPrelude = switch $
204− long "no-prelude"
205− <> help "Omit the automatic Prelude import"
206−
207−comments :: Parser Bool
208−comments = switch $
209− short 'c'
210− <> long "comments"
211− <> help "Include comments in the generated code."
212−
213−useStdIn :: Parser Bool
214−useStdIn = switch $
215− short 's'
216− <> long "stdin"
217− <> help "Read from standard input"
218−
219−inputFile :: Parser FilePath
220−inputFile = strArgument $
221− metavar "FILE"
222− <> help "The input .purs file(s)"
223−
224−inputForeignFile :: Parser FilePath
225−inputForeignFile = strOption $
226− short 'f'
227− <> long "ffi"
228− <> help "The input .js file(s) providing foreign import implementations"
229−
230−outputFile :: Parser (Maybe FilePath)
231−outputFile = optional . strOption $
232− short 'o'
233− <> long "output"
234− <> help "The output .js file"
235−
236−externsFile :: Parser (Maybe FilePath)
237−externsFile = optional . strOption $
238− short 'e'
239− <> long "externs"
240− <> help "The output .e.purs file"
241−
242−noPrefix :: Parser Bool
243−noPrefix = switch $
244− short 'p'
245− <> long "no-prefix"
246− <> help "Do not include comment header"
247−
248−options :: Parser (P.Options P.Compile)
249−options = P.Options <$> noPrelude
250− <*> noTco
251− <*> noMagicDo
252− <*> runMain
253− <*> noOpts
254− <*> verboseErrors
255− <*> (not <$> comments)
256− <*> additionalOptions
257− where
258− additionalOptions =
259− P.CompileOptions <$> browserNamespace
260− <*> many dceModule
261− <*> many codeGenModule
262−
263−pscOptions :: Parser PSCOptions
264−pscOptions = PSCOptions <$> many inputFile
265− <*> many inputForeignFile
266− <*> options
267− <*> useStdIn
268− <*> outputFile
269− <*> externsFile
270− <*> (not <$> noPrefix)
271−
272−main :: IO ()
273−main = execParser opts >>= compile
274− where
275− opts = info (version <*> helper <*> pscOptions) infoModList
276− infoModList = fullDesc <> headerInfo <> footerInfo
277− headerInfo = header "psc - Compiles PureScript to Javascript"
278− footerInfo = footer $ "psc " ++ showVersion Paths.version
279−
280− version :: Parser (a -> a)
281− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psci/Completion.hsdeleted−223
@@ -1,223 +0,0 @@
1−module Completion where
2−
3−import Data.Maybe (mapMaybe)
4−import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)
5−import Data.Char (isUpper)
6−import Data.Function (on)
7−import Data.Traversable (traverse)
8−
9−import Control.Applicative ((<$>), (<*>))
10−import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
11−import Control.Monad.Trans.State.Strict
12−
13−import System.Console.Haskeline
14−
15−import qualified Language.PureScript as P
16−import qualified Language.PureScript.Names as N
17−
18−import qualified Directive as D
19−import Types
20−
21−-- Completions may read the state, but not modify it.
22−type CompletionM = ReaderT PSCiState IO
23−
24−-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.
25−liftCompletionM :: CompletionM a -> StateT PSCiState IO a
26−liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)
27−
28−-- Haskeline completions
29−
30−data CompletionContext
31− = CtxDirective String
32− | CtxFilePath String
33− | CtxModule
34− | CtxIdentifier
35− | CtxType
36− | CtxFixed String
37− deriving (Show)
38−
39−-- |
40−-- Loads module, function, and file completions.
41−--
42−completion :: CompletionFunc (StateT PSCiState IO)
43−completion = liftCompletionM . completion'
44−
45−completion' :: CompletionFunc CompletionM
46−completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
47−
48−-- |
49−-- Decide what kind of completion we need based on input. This function expects
50−-- a list of complete words (to the left of the cursor) as the first argument,
51−-- and the current word as the second argument.
52−completionContext :: [String] -> String -> [CompletionContext]
53−completionContext [] _ = [CtxDirective "", CtxIdentifier, CtxFixed "import"]
54−completionContext ws w | headSatisfies (":" `isPrefixOf`) ws = completeDirective ws w
55−completionContext ws w | headSatisfies (== "import") ws = completeImport ws w
56−completionContext _ _ = [CtxIdentifier]
57−
58−completeDirective :: [String] -> String -> [CompletionContext]
59−completeDirective ws w =
60− case ws of
61− [] -> [CtxDirective w]
62− [dir] -> case D.directivesFor <$> stripPrefix ":" dir of
63− -- only offer completions if the directive is unambiguous
64− Just [dir'] -> directiveArg w dir'
65− _ -> []
66−
67− -- All directives take exactly one argument. If we haven't yet matched,
68− -- that means one argument has already been supplied. So don't complete
69− -- any others.
70− _ -> []
71−
72−directiveArg :: String -> Directive -> [CompletionContext]
73−directiveArg _ Browse = [CtxModule]
74−directiveArg w Load = [CtxFilePath w]
75−directiveArg _ Quit = []
76−directiveArg _ Reset = []
77−directiveArg _ Help = []
78−directiveArg _ Show = map CtxFixed replQueryStrings
79−directiveArg _ Type = [CtxIdentifier]
80−directiveArg _ Kind = [CtxType]
81−
82−completeImport :: [String] -> String -> [CompletionContext]
83−completeImport ws w' =
84− case (ws, w') of
85− (["import"], w) | headSatisfies isUpper w -> [CtxModule]
86− (["import"], _) -> [CtxModule, CtxFixed "qualified"]
87− (["import", "qualified"], _) -> [CtxModule]
88− _ -> []
89−
90−headSatisfies :: (a -> Bool) -> [a] -> Bool
91−headSatisfies p str =
92− case str of
93− (c:_) -> p c
94− _ -> False
95−
96−-- | Callback for Haskeline's `completeWordWithPrev`.
97−-- Expects:
98−-- * Line contents to the left of the word, reversed
99−-- * Word to be completed
100−findCompletions :: String -> String -> CompletionM [Completion]
101−findCompletions prev word = do
102− let ctx = completionContext (words (reverse prev)) word
103− completions <- concat <$> traverse getCompletions ctx
104− return $ sortBy directivesFirst completions
105− where
106− getCompletions :: CompletionContext -> CompletionM [Completion]
107− getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
108−
109− prefixedBy :: String -> String -> Maybe Completion
110− prefixedBy w cand = if w `isPrefixOf` cand
111− then Just (simpleCompletion cand)
112− else Nothing
113−
114−getCompletion :: CompletionContext -> CompletionM [Either String Completion]
115−getCompletion ctx =
116− case ctx of
117− CtxFilePath f -> map Right <$> listFiles f
118− CtxModule -> map Left <$> getModuleNames
119− CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
120− CtxType -> map Left <$> getTypeNames
121− CtxFixed str -> return [Left str]
122− CtxDirective d -> return (map Left (completeDirectives d))
123−
124− where
125− completeDirectives :: String -> [String]
126− completeDirectives = map (':' :) . D.directiveStringsFor
127−
128−
129−getLoadedModules :: CompletionM [P.Module]
130−getLoadedModules = asks (map snd . psciLoadedModules)
131−
132−getImportedModules :: CompletionM [ImportedModule]
133−getImportedModules = asks psciImportedModules
134−
135−getModuleNames :: CompletionM [String]
136−getModuleNames = moduleNames <$> getLoadedModules
137−
138−mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [(a, P.Declaration)]) -> CompletionM [String]
139−mapLoadedModulesAndQualify f = do
140− ms <- getLoadedModules
141− let argPairs = do m <- ms
142− fm <- f m
143− return (m, fm)
144− concat <$> traverse (uncurry getAllQualifications) argPairs
145−
146−getIdentNames :: CompletionM [String]
147−getIdentNames = mapLoadedModulesAndQualify identNames
148−
149−getDctorNames :: CompletionM [String]
150−getDctorNames = mapLoadedModulesAndQualify dctorNames
151−
152−getTypeNames :: CompletionM [String]
153−getTypeNames = mapLoadedModulesAndQualify typeDecls
154−
155−-- | Given a module and a declaration in that module, return all possible ways
156−-- it could have been referenced given the current PSCiState - including fully
157−-- qualified, qualified using an alias, and unqualified.
158−getAllQualifications :: (Show a) => P.Module -> (a, P.Declaration) -> CompletionM [String]
159−getAllQualifications m (declName, decl) = do
160− imports <- getAllImportsOf m
161− let fullyQualified = qualifyWith (Just (P.getModuleName m))
162− let otherQuals = nub (concatMap qualificationsUsing imports)
163− return $ fullyQualified : otherQuals
164− where
165− qualifyWith mMod = show (P.Qualified mMod declName)
166− referencedBy refs = P.isExported (Just refs) decl
167−
168− qualificationsUsing (_, importType, asQ') =
169− let q = qualifyWith asQ'
170− in case importType of
171− P.Implicit -> [q]
172− P.Explicit refs -> if referencedBy refs
173− then [q]
174− else []
175− P.Hiding refs -> if referencedBy refs
176− then []
177− else [q]
178−
179−
180−-- | Returns all the ImportedModule values referring to imports of a particular
181−-- module.
182−getAllImportsOf :: P.Module -> CompletionM [ImportedModule]
183−getAllImportsOf = asks . allImportsOf
184−
185−nubOnFst :: Eq a => [(a, b)] -> [(a, b)]
186−nubOnFst = nubBy ((==) `on` fst)
187−
188−typeDecls :: P.Module -> [(N.ProperName, P.Declaration)]
189−typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations
190− where
191− getTypeName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)
192− getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)
193− getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)
194− getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
195− getTypeName _ = Nothing
196−
197−identNames :: P.Module -> [(N.Ident, P.Declaration)]
198−identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations
199− where
200− getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)
201− getDeclName d@(P.ValueDeclaration ident _ _ _) = Just (ident, d)
202− getDeclName d@(P.ExternDeclaration ident _) = Just (ident, d)
203− getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d
204− getDeclName _ = Nothing
205−
206−dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]
207−dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
208− where
209− go :: P.Declaration -> [(N.ProperName, P.Declaration)]
210− go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)
211− go (P.PositionedDeclaration _ _ d) = go d
212− go _ = []
213−
214−moduleNames :: [P.Module] -> [String]
215−moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
216−
217−directivesFirst :: Completion -> Completion -> Ordering
218−directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
219− where
220− go (':' : xs) (':' : ys) = compare xs ys
221− go (':' : _) _ = LT
222− go _ (':' : _) = GT
223− go xs ys = compare xs ys
psci/Directive.hsdeleted−113
@@ -1,113 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Directive
4−-- Copyright :
5−-- License : MIT
6−--
7−-- Maintainer :
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Directives for PSCI.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Directive where
17−
18−import Data.Maybe (fromJust, listToMaybe)
19−import Data.List (isPrefixOf)
20−import Data.Tuple (swap)
21−
22−import Types
23−
24−-- |
25−-- List of all avaliable directives.
26−--
27−directives :: [Directive]
28−directives = map fst directiveStrings
29−
30−-- |
31−-- A mapping of directives to the different strings that can be used to invoke
32−-- them.
33−--
34−directiveStrings :: [(Directive, [String])]
35−directiveStrings =
36− [ (Help , ["?", "help"])
37− , (Quit , ["quit"])
38− , (Reset , ["reset"])
39− , (Browse , ["browse"])
40− , (Load , ["load", "module"])
41− , (Type , ["type"])
42− , (Kind , ["kind"])
43− , (Show , ["show"])
44− ]
45−
46−-- |
47−-- Like directiveStrings, but the other way around.
48−--
49−directiveStrings' :: [(String, Directive)]
50−directiveStrings' = concatMap go directiveStrings
51− where
52− go (dir, strs) = map (\s -> (s, dir)) strs
53−
54−-- |
55−-- List of all directive strings.
56−--
57−strings :: [String]
58−strings = concatMap snd directiveStrings
59−
60−-- |
61−-- Returns all possible string representations of a directive.
62−--
63−stringsFor :: Directive -> [String]
64−stringsFor d = fromJust (lookup d directiveStrings)
65−
66−-- |
67−-- Returns the default string representation of a directive.
68−--
69−stringFor :: Directive -> String
70−stringFor = head . stringsFor
71−
72−-- |
73−-- Returns the list of directives which could be expanded from the string
74−-- argument, together with the string alias that matched.
75−--
76−directivesFor' :: String -> [(Directive, String)]
77−directivesFor' str = go directiveStrings'
78− where
79− go = map swap . filter ((str `isPrefixOf`) . fst)
80−
81−directivesFor :: String -> [Directive]
82−directivesFor = map fst . directivesFor'
83−
84−directiveStringsFor :: String -> [String]
85−directiveStringsFor = map snd . directivesFor'
86−
87−parseDirective :: String -> Maybe Directive
88−parseDirective = listToMaybe . directivesFor
89−
90−-- |
91−-- True if the given directive takes an argument, false otherwise.
92−hasArgument :: Directive -> Bool
93−hasArgument Help = False
94−hasArgument Quit = False
95−hasArgument Reset = False
96−hasArgument _ = True
97−
98−-- |
99−-- The help menu.
100−--
101−help :: [(Directive, String, String)]
102−help =
103− [ (Help, "", "Show this help menu")
104− , (Quit, "", "Quit PSCi")
105− , (Reset, "", "Discard all imported modules and declared bindings")
106− , (Browse, "<module>", "See all functions in <module>")
107− , (Load, "<file>", "Load <file> for importing")
108− , (Type, "<expr>", "Show the type of <expr>")
109− , (Kind, "<type>", "Show the kind of <type>")
110− , (Show, "import", "Show all imported modules")
111− , (Show, "loaded", "Show all loaded modules")
112− ]
113−
psci/IO.hsdeleted−21
@@ -1,21 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : IO
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−module IO where
16−
17−import System.Directory (createDirectoryIfMissing)
18−import System.FilePath (takeDirectory)
19−
20−mkdirp :: FilePath -> IO ()
21−mkdirp = createDirectoryIfMissing True . takeDirectory
psci/Make.hsdeleted−127
@@ -1,127 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Make
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DataKinds #-}
16−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17−{-# LANGUAGE TupleSections #-}
18−
19−module Make where
20−
21−import Data.List (isPrefixOf)
22−import Data.Maybe (fromMaybe)
23−import Data.Time.Clock
24−import Data.Traversable (traverse)
25−import qualified Data.Map as M
26−
27−import Control.Applicative
28−import Control.Monad
29−import Control.Monad.Error.Class (MonadError(..))
30−import Control.Monad.IO.Class (MonadIO, liftIO)
31−import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
32−import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
33−import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
34−
35−import System.Directory (getModificationTime, doesFileExist)
36−import System.FilePath ((</>), pathSeparator)
37−import System.IO.Error (tryIOError)
38−
39−import qualified Language.PureScript as P
40−import qualified Language.PureScript.CodeGen.JS as J
41−import qualified Language.PureScript.CoreFn as CF
42−
43−import IO (mkdirp)
44−
45−options :: P.Options P.Make
46−options = P.Options False False False Nothing False False False P.MakeOptions
47−
48−modulesDir :: FilePath
49−modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
50−
51−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
52− deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))
53−
54−runMake :: Make a -> IO (Either P.MultipleErrors a)
55−runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake
56−
57−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
58−makeIO f io = do
59− e <- liftIO $ tryIOError io
60− either (throwError . P.singleError . f) return e
61−
62−-- Traverse (Either e) instance (base 4.7)
63−traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
64−traverseEither _ (Left x) = pure (Left x)
65−traverseEither f (Right y) = Right <$> f y
66−
67−buildMakeActions :: M.Map P.ModuleName (Either P.RebuildPolicy String)
68− -> M.Map P.ModuleName P.ForeignJS
69− -> P.MakeActions Make
70−buildMakeActions filePathMap foreigns =
71− P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
72− where
73−
74− getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
75− getInputTimestamp mn = do
76− let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
77− traverseEither getTimestamp path
78−
79− getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
80− getOutputTimestamp mn = do
81− let filePath = P.runModuleName mn
82− jsFile = modulesDir </> filePath </> "index.js"
83− externsFile = modulesDir </> filePath </> "externs.purs"
84− min <$> getTimestamp jsFile <*> getTimestamp externsFile
85−
86− readExterns :: P.ModuleName -> Make (FilePath, String)
87− readExterns mn = do
88− let path = modulesDir </> P.runModuleName mn </> "externs.purs"
89− (path, ) <$> readTextFile path
90−
91− codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()
92− codegen m _ nextVar exts = do
93− let mn = CF.moduleName m
94− foreignInclude <- case CF.moduleName m `M.lookup` foreigns of
95− Just path
96− | not $ requiresForeign m -> do tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
97− return Nothing
98− | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
99− Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn
100− | otherwise -> return Nothing
101− pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
102− let filePath = P.runModuleName $ CF.moduleName m
103− jsFile = modulesDir </> filePath </> "index.js"
104− externsFile = modulesDir </> filePath </> "externs.purs"
105− foreignFile = modulesDir </> filePath </> "foreign.js"
106− writeTextFile jsFile pjs
107− maybe (return ()) (writeTextFile foreignFile) $ CF.moduleName m `M.lookup` foreigns
108− writeTextFile externsFile exts
109−
110− requiresForeign :: CF.Module a -> Bool
111− requiresForeign = not . null . CF.moduleForeign
112−
113− getTimestamp :: FilePath -> Make (Maybe UTCTime)
114− getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
115− exists <- doesFileExist path
116− traverse (const $ getModificationTime path) $ guard exists
117−
118− readTextFile :: FilePath -> Make String
119− readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ readFile path
120−
121− writeTextFile :: FilePath -> String -> Make ()
122− writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
123− mkdirp path
124− writeFile path text
125−
126− progress :: String -> Make ()
127− progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s
psci/PSCi.hsdeleted−560
@@ -1,560 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : PSCi
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- PureScript Compiler Interactive.
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DoAndIfThenElse #-}
17−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18−{-# LANGUAGE RecordWildCards #-}
19−{-# LANGUAGE TupleSections #-}
20−
21−module PSCi where
22−
23−import Data.Foldable (traverse_)
24−import Data.List (intercalate, nub, sort)
25−import Data.Traversable (traverse)
26−import Data.Tuple (swap)
27−import Data.Version (showVersion)
28−import qualified Data.Map as M
29−
30−import Control.Applicative
31−import Control.Arrow (first)
32−import Control.Monad
33−import Control.Monad.Trans.Class
34−import Control.Monad.Trans.Except (runExceptT)
35−import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
36−import Control.Monad.Trans.State.Strict
37−import Control.Monad.Writer (runWriter)
38−import qualified Control.Monad.Trans.State.Lazy as L
39−
40−import Options.Applicative as Opts
41−
42−import System.Console.Haskeline
43−import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)
44−import System.Exit
45−import System.FilePath (pathSeparator, (</>), isPathSeparator)
46−import System.Process (readProcessWithExitCode)
47−
48−import qualified Language.PureScript as P
49−import qualified Language.PureScript.Names as N
50−import qualified Paths_purescript as Paths
51−
52−import qualified Directive as D
53−import Completion (completion)
54−import IO (mkdirp)
55−import Make
56−import Parser (parseCommand)
57−import Types
58−
59−-- | The name of the PSCI support module
60−supportModuleName :: P.ModuleName
61−supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]
62−
63−-- | Support module, contains code to evaluate terms
64−supportModule :: P.Module
65−supportModule =
66− case P.parseModulesFromFiles id [("", code)] of
67− Right [(_, P.Module cs _ ds exps)] -> P.Module cs supportModuleName ds exps
68− _ -> error "Support module could not be parsed"
69− where
70− code :: String
71− code = unlines
72− [ "module S where"
73− , ""
74− , "import Console"
75− , ""
76− , "import Control.Monad.Eff"
77− , "import Control.Monad.Eff.Unsafe"
78− , ""
79− , "class Eval a where"
80− , " eval :: a -> Eff (console :: CONSOLE) Unit"
81− , ""
82− , "instance evalShow :: (Show a) => Eval a where"
83− , " eval = print"
84− , ""
85− , "instance evalEff :: (Eval a) => Eval (Eff eff a) where"
86− , " eval x = unsafeInterleaveEff x >>= eval"
87− ]
88−
89−-- File helpers
90−
91−-- |
92−-- Load the necessary modules.
93−--
94−defaultImports :: [ImportedModule]
95−defaultImports = [(P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
96−
97−-- |
98−-- Locates the node executable.
99−-- Checks for either @nodejs@ or @node@.
100−--
101−findNodeProcess :: IO (Maybe String)
102−findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
103− where names = ["nodejs", "node"]
104−
105−-- |
106−-- Grabs the filename where the history is stored.
107−--
108−getHistoryFilename :: IO FilePath
109−getHistoryFilename = do
110− home <- getHomeDirectory
111− let filename = home </> ".purescript" </> "psci_history"
112− mkdirp filename
113− return filename
114−
115−-- |
116−-- Loads a file for use with imports.
117−--
118−loadModule :: FilePath -> IO (Either String [P.Module])
119−loadModule filename = do
120− content <- readFile filename
121− return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
122−
123−-- |
124−-- Load all modules, including the Prelude
125−--
126−loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])
127−loadAllModules files = do
128− filesAndContent <- forM files $ \filename -> do
129− content <- readFile filename
130− return (Right filename, content)
131− return $ P.parseModulesFromFiles (either (const "") id) filesAndContent
132−
133−-- |
134−-- Load all modules, updating the application state
135−--
136−loadAllImportedModules :: PSCI ()
137−loadAllImportedModules = do
138− files <- PSCI . lift $ fmap psciImportedFilenames get
139− modulesOrFirstError <- psciIO $ loadAllModules files
140− case modulesOrFirstError of
141− Left errs -> printErrors errs
142− Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
143−
144−-- |
145−-- Expands tilde in path.
146−--
147−expandTilde :: FilePath -> IO FilePath
148−expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
149−expandTilde p = return p
150−
151−-- Messages
152−
153−-- |
154−-- The help message.
155−--
156−helpMessage :: String
157−helpMessage = "The following commands are available:\n\n " ++
158− intercalate "\n " (map line D.help) ++
159− "\n\n" ++ extraHelp
160− where
161− line :: (Directive, String, String) -> String
162− line (dir, arg, desc) =
163− let cmd = ':' : D.stringFor dir
164− in unwords [ cmd
165− , replicate (11 - length cmd) ' '
166− , arg
167− , replicate (11 - length arg) ' '
168− , desc
169− ]
170−
171− extraHelp =
172− "Further information is available on the PureScript wiki:\n" ++
173− " --> https://github.com/purescript/purescript/wiki/psci"
174−
175−
176−-- |
177−-- The welcome prologue.
178−--
179−prologueMessage :: String
180−prologueMessage = intercalate "\n"
181− [ " ____ ____ _ _ "
182− , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
183− , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
184− , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
185− , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
186− , " |_| "
187− , ""
188− , ":? shows help"
189− ]
190−
191−-- |
192−-- The quit message.
193−--
194−quitMessage :: String
195−quitMessage = "See ya!"
196−
197−-- |
198−-- PSCI monad
199−--
200−newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
201−
202−psciIO :: IO a -> PSCI a
203−psciIO io = PSCI . lift $ lift io
204−
205−-- |
206−-- Makes a volatile module to execute the current expression.
207−--
208−createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module
209−createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =
210− let
211− moduleName = P.ModuleName [P.ProperName "$PSCI"]
212− trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))
213− mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))
214− itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val
215− mainDecl = P.ValueDeclaration (P.Ident "main") P.Public [] $ Right mainValue
216− decls = if exec then [itDecl, mainDecl] else [itDecl]
217− in
218− P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
219−
220−
221−-- |
222−-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
223−--
224−createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
225−createTemporaryModuleForKind PSCiState{psciImportedModules = imports} typ =
226− let
227− moduleName = P.ModuleName [P.ProperName "$PSCI"]
228− itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
229− in
230− P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing
231−
232−-- |
233−-- Makes a volatile module to execute the current imports.
234−--
235−createTemporaryModuleForImports :: PSCiState -> P.Module
236−createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
237− let
238− moduleName = P.ModuleName [P.ProperName "$PSCI"]
239− in
240− P.Module [] moduleName (importDecl `map` imports) Nothing
241−
242−importDecl :: ImportedModule -> P.Declaration
243−importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
244−
245−indexFile :: FilePath
246−indexFile = ".psci_modules" ++ pathSeparator : "index.js"
247−
248−make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> Make P.Environment
249−make PSCiState{..} ms =
250− let filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)
251− in P.make (buildMakeActions filePathMap (M.map snd psciForeignFiles)) (psciLoadedModules ++ ms)
252−
253−-- |
254−-- Takes a value declaration and evaluates it with the current state.
255−--
256−handleDeclaration :: P.Expr -> PSCI ()
257−handleDeclaration val = do
258− st <- PSCI $ lift get
259− let m = createTemporaryModule True st val
260− let nodeArgs = psciNodeFlags st ++ [indexFile]
261− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]
262− case e of
263− Left errs -> printErrors errs
264− Right _ -> do
265− psciIO $ writeFile indexFile "require('$PSCI').main();"
266− process <- psciIO findNodeProcess
267− result <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
268− case result of
269− Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
270− Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
271− Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
272−
273−-- |
274−-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
275−-- restore the original environment.
276−--
277−handleDecls :: [P.Declaration] -> PSCI ()
278−handleDecls ds = do
279− st <- PSCI $ lift get
280− let st' = updateLets ds st
281− let m = createTemporaryModule False st' (P.ObjectLiteral [])
282− e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]
283− case e of
284− Left err -> printErrors err
285− Right _ -> PSCI $ lift (put st')
286−
287−-- |
288−-- Show actual loaded modules in psci.
289−--
290−handleShowLoadedModules :: PSCI ()
291−handleShowLoadedModules = do
292− PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get
293− psciIO $ readModules loadedModules >>= putStrLn
294− return ()
295− where readModules = return . unlines . sort . nub . map toModuleName
296− toModuleName = N.runModuleName . (\ (P.Module _ mdName _ _) -> mdName) . snd
297−
298−-- |
299−-- Show the imported modules in psci.
300−--
301−handleShowImportedModules :: PSCI ()
302−handleShowImportedModules = do
303− PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get
304− psciIO $ showModules importedModules >>= putStrLn
305− return ()
306− where
307− showModules = return . unlines . sort . map showModule
308− showModule (mn, declType, asQ) =
309− "import " ++ case asQ of
310− Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
311− Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
312−
313− showDeclType P.Implicit = ""
314− showDeclType (P.Explicit refs) = refsList refs
315− showDeclType (P.Hiding refs) = "hiding " ++ refsList refs
316− refsList refs = "(" ++ commaList (map showRef refs) ++ ")"
317−
318− showRef :: P.DeclarationRef -> String
319− showRef (P.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
320− showRef (P.ValueRef ident) = show ident
321− showRef (P.TypeClassRef pn) = show pn
322− showRef (P.TypeInstanceRef ident) = show ident
323− showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
324−
325− commaList :: [String] -> String
326− commaList = intercalate ", "
327−
328−-- |
329−-- Imports a module, preserving the initial state on failure.
330−--
331−handleImport :: ImportedModule -> PSCI ()
332−handleImport im = do
333− st <- updateImportedModules im <$> PSCI (lift get)
334− let m = createTemporaryModuleForImports st
335− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
336− case e of
337− Left errs -> printErrors errs
338− Right _ -> do
339− PSCI $ lift $ put st
340− return ()
341−
342−-- |
343−-- Takes a value and prints its type
344−--
345−handleTypeOf :: P.Expr -> PSCI ()
346−handleTypeOf val = do
347− st <- PSCI $ lift get
348− let m = createTemporaryModule False st val
349− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
350− case e of
351− Left errs -> printErrors errs
352− Right env' ->
353− case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
354− Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
355− Nothing -> PSCI $ outputStrLn "Could not find type"
356−
357−-- |
358−-- Pretty print a module's signatures
359−--
360−printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()
361−printModuleSignatures moduleName env =
362− PSCI $ let namesEnv = P.names env
363− moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) namesEnv
364− in case moduleNamesIdent of
365− [] -> outputStrLn $ "This module '"++ P.runModuleName moduleName ++"' does not export functions."
366− _ -> ( outputStrLn
367− . unlines
368− . sort
369− . map (showType . findType namesEnv)) moduleNamesIdent
370− where findType :: M.Map (P.ModuleName, P.Ident) (P.Type, P.NameKind, P.NameVisibility) -> (P.ModuleName, P.Ident) -> (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility))
371− findType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)
372− showType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> String
373− showType (mIdent, Just (mType, _, _)) = show mIdent ++ " :: " ++ P.prettyPrintType mType
374− showType _ = error "The impossible happened in printModuleSignatures."
375−
376−-- |
377−-- Browse a module and displays its signature (if module exists).
378−--
379−handleBrowse :: P.ModuleName -> PSCI ()
380−handleBrowse moduleName = do
381− st <- PSCI $ lift get
382− env <- psciIO . runMake $ make st []
383− case env of
384− Left errs -> printErrors errs
385− Right env' ->
386− if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) (psciLoadedModules st)
387− then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."
388− else printModuleSignatures moduleName env'
389−
390−-- | Pretty-print errors
391−printErrors :: P.MultipleErrors -> PSCI ()
392−printErrors = PSCI . outputStrLn . P.prettyPrintMultipleErrors False
393−
394−-- |
395−-- Takes a value and prints its kind
396−--
397−handleKindOf :: P.Type -> PSCI ()
398−handleKindOf typ = do
399− st <- PSCI $ lift get
400− let m = createTemporaryModuleForKind st typ
401− mName = P.ModuleName [P.ProperName "$PSCI"]
402− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
403− case e of
404− Left errs -> printErrors errs
405− Right env' ->
406− case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
407− Just (_, typ') -> do
408− let chk = P.CheckState env' 0 0 (Just mName)
409− k = fst . runWriter . runExceptT $ L.runStateT (P.unCheck (P.kindOf mName typ')) chk
410− case k of
411− Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
412− Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
413− Nothing -> PSCI $ outputStrLn "Could not find kind"
414−
415−-- Commands
416−
417−-- |
418−-- Parses the input and returns either a Metacommand, or an error as a string.
419−--
420−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
421−getCommand singleLineMode = do
422− firstLine <- getInputLine "> "
423− case firstLine of
424− Nothing -> return (Right Nothing)
425− Just "" -> return (Right Nothing)
426− Just s | singleLineMode || head s == ':' -> return . either Left (Right . Just) $ parseCommand s
427− Just s -> either Left (Right . Just) . parseCommand <$> go [s]
428− where
429− go :: [String] -> InputT (StateT PSCiState IO) String
430− go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
431−
432−-- |
433−-- Performs an action for each meta-command given, and also for expressions.
434−--
435−handleCommand :: Command -> PSCI ()
436−handleCommand (Expression val) = handleDeclaration val
437−handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
438−handleCommand (Import im) = handleImport im
439−handleCommand (Decls l) = handleDecls l
440−handleCommand (LoadFile filePath) = do
441− absPath <- psciIO $ expandTilde filePath
442− exists <- psciIO $ doesFileExist absPath
443− if exists then do
444− PSCI . lift $ modify (updateImportedFiles absPath)
445− m <- psciIO $ loadModule absPath
446− case m of
447− Left err -> PSCI $ outputStrLn err
448− Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
449− else
450− PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
451−handleCommand ResetState = do
452− files <- psciImportedFilenames <$> PSCI (lift get)
453− PSCI . lift . modify $ \st -> st
454− { psciImportedFilenames = files
455− , psciImportedModules = defaultImports
456− , psciLetBindings = []
457− }
458− loadAllImportedModules
459−handleCommand (TypeOf val) = handleTypeOf val
460−handleCommand (KindOf typ) = handleKindOf typ
461−handleCommand (BrowseModule moduleName) = handleBrowse moduleName
462−handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
463−handleCommand (ShowInfo QueryImport) = handleShowImportedModules
464−handleCommand QuitPSCi = error "`handleCommand QuitPSCi` was called. This is a bug."
465−
466−loadUserConfig :: IO (Maybe [Command])
467−loadUserConfig = do
468− configFile <- (</> ".psci") <$> getCurrentDirectory
469− exists <- doesFileExist configFile
470− if exists
471− then do
472− ls <- lines <$> readFile configFile
473− case mapM parseCommand ls of
474− Left err -> print err >> exitFailure
475− Right cs -> return $ Just cs
476− else
477− return Nothing
478−
479−-- | Checks if the Console module is defined
480−consoleIsDefined :: [P.Module] -> Bool
481−consoleIsDefined = any ((== P.ModuleName [P.ProperName "Console"]) . P.getModuleName)
482−
483−-- |
484−-- The PSCI main loop.
485−--
486−loop :: PSCiOptions -> IO ()
487−loop PSCiOptions{..} = do
488− config <- loadUserConfig
489− modulesOrFirstError <- loadAllModules psciInputFile
490− case modulesOrFirstError of
491− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
492− Right modules -> do
493− historyFilename <- getHistoryFilename
494− let settings = defaultSettings { historyFile = Just historyFilename }
495− foreignsOrError <- runMake $ do
496− foreignFiles <- forM psciForeignInputFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))
497− P.parseForeignModulesFromFiles foreignFiles
498− case foreignsOrError of
499− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
500− Right foreigns ->
501− flip evalStateT (PSCiState psciInputFile defaultImports modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
502− outputStrLn prologueMessage
503− traverse_ (mapM_ (runPSCI . handleCommand)) config
504− unless (consoleIsDefined (map snd modules)) . outputStrLn $ unlines
505− [ "PSCi requires the purescript-console module to be installed."
506− , "For help getting started, visit http://wiki.purescript.org/PSCi"
507− ]
508− go
509− where
510− go :: InputT (StateT PSCiState IO) ()
511− go = do
512− c <- getCommand (not psciMultiLineMode)
513− case c of
514− Left err -> outputStrLn err >> go
515− Right Nothing -> go
516− Right (Just QuitPSCi) -> outputStrLn quitMessage
517− Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go
518−
519−multiLineMode :: Parser Bool
520−multiLineMode = switch $
521− long "multi-line-mode"
522− <> short 'm'
523− <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
524−
525−inputFile :: Parser FilePath
526−inputFile = strArgument $
527− metavar "FILE"
528− <> Opts.help "Optional .purs files to load on start"
529−
530−inputForeignFile :: Parser FilePath
531−inputForeignFile = strOption $
532− short 'f'
533− <> long "ffi"
534− <> help "The input .js file(s) providing foreign import implementations"
535−
536−nodeFlagsFlag :: Parser [String]
537−nodeFlagsFlag = option parser $
538− long "node-opts"
539− <> metavar "NODE_OPTS"
540− <> value []
541− <> Opts.help "Flags to pass to node, separated by spaces"
542− where
543− parser = words <$> str
544−
545−psciOptions :: Parser PSCiOptions
546−psciOptions = PSCiOptions <$> multiLineMode
547− <*> many inputFile
548− <*> many inputForeignFile
549− <*> nodeFlagsFlag
550−
551−runPSCi :: IO ()
552−runPSCi = execParser opts >>= loop
553− where
554− opts = info (version <*> helper <*> psciOptions) infoModList
555− infoModList = fullDesc <> headerInfo <> footerInfo
556− headerInfo = header "psci - Interactive mode for PureScript"
557− footerInfo = footer $ "psci " ++ showVersion Paths.version
558−
559− version :: Parser (a -> a)
560− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
psci/Parser.hsdeleted−139
@@ -1,139 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Parser
4−-- Copyright : (c) Phil Freeman 2014
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Parser for PSCI.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Parser
17− ( parseCommand
18− ) where
19−
20−import Prelude hiding (lex)
21−
22−import Data.Char (isSpace)
23−import Data.List (intercalate)
24−
25−import Control.Applicative hiding (many)
26−
27−import Text.Parsec hiding ((<|>))
28−
29−import qualified Language.PureScript as P
30−import Language.PureScript.Parser.Common (mark, same)
31−
32−import qualified Directive as D
33−import Types
34−
35−-- |
36−-- Parses PSCI metacommands or expressions input from the user.
37−--
38−parseCommand :: String -> Either String Command
39−parseCommand cmdString =
40− case cmdString of
41− (':' : cmd) -> parseDirective cmd
42− _ -> parseRest psciCommand cmdString
43−
44−parseRest :: P.TokenParser a -> String -> Either String a
45−parseRest p s = either (Left . show) Right $ do
46− ts <- P.lex "" s
47− P.runTokenParser "" (p <* eof) ts
48−
49−psciCommand :: P.TokenParser Command
50−psciCommand = choice (map try parsers)
51− where
52− parsers =
53− [ psciLet
54− , psciImport
55− , psciOtherDeclaration
56− , psciExpression
57− ]
58−
59−trim :: String -> String
60−trim = trimEnd . trimStart
61−
62−trimStart :: String -> String
63−trimStart = dropWhile isSpace
64−
65−trimEnd :: String -> String
66−trimEnd = reverse . trimStart . reverse
67−
68−parseDirective :: String -> Either String Command
69−parseDirective cmd =
70− case D.directivesFor' dstr of
71− [(d, _)] -> commandFor d
72− [] -> Left "Unrecognized directive. Type :? for help."
73− ds -> Left ("Ambiguous directive. Possible matches: " ++
74− intercalate ", " (map snd ds) ++ ". Type :? for help.")
75− where
76− (dstr, arg) = break isSpace cmd
77−
78− commandFor d = case d of
79− Help -> return ShowHelp
80− Quit -> return QuitPSCi
81− Reset -> return ResetState
82− Browse -> BrowseModule <$> parseRest P.moduleName arg
83− Load -> return $ LoadFile (trim arg)
84− Show -> ShowInfo <$> parseReplQuery' (trim arg)
85− Type -> TypeOf <$> parseRest P.parseValue arg
86− Kind -> KindOf <$> parseRest P.parseType arg
87−
88−-- |
89−-- Parses expressions entered at the PSCI repl.
90−--
91−psciExpression :: P.TokenParser Command
92−psciExpression = Expression <$> P.parseValue
93−
94−-- |
95−-- PSCI version of @let@.
96−-- This is essentially let from do-notation.
97−-- However, since we don't support the @Eff@ monad,
98−-- we actually want the normal @let@.
99−--
100−psciLet :: P.TokenParser Command
101−psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
102− where
103− manyDecls :: P.TokenParser [P.Declaration]
104− manyDecls = mark (many1 (same *> P.parseLocalDeclaration))
105−
106−-- | Imports must be handled separately from other declarations, so that
107−-- :show import works, for example.
108−psciImport :: P.TokenParser Command
109−psciImport = Import <$> P.parseImportDeclaration'
110−
111−-- | Any other declaration that we don't need a 'special case' parser for
112−-- (like let or import declarations).
113−psciOtherDeclaration :: P.TokenParser Command
114−psciOtherDeclaration = Decls . (:[]) <$> do
115− decl <- discardPositionInfo <$> P.parseDeclaration
116− if acceptable decl
117− then return decl
118− else fail "this kind of declaration is not supported in psci"
119−
120−discardPositionInfo :: P.Declaration -> P.Declaration
121−discardPositionInfo (P.PositionedDeclaration _ _ d) = d
122−discardPositionInfo d = d
123−
124−acceptable :: P.Declaration -> Bool
125−acceptable P.DataDeclaration{} = True
126−acceptable P.TypeSynonymDeclaration{} = True
127−acceptable P.ExternDeclaration{} = True
128−acceptable P.ExternDataDeclaration{} = True
129−acceptable P.ExternInstanceDeclaration{} = True
130−acceptable P.TypeClassDeclaration{} = True
131−acceptable P.TypeInstanceDeclaration{} = True
132−acceptable _ = False
133−
134−parseReplQuery' :: String -> Either String ReplQuery
135−parseReplQuery' str =
136− case parseReplQuery str of
137− Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++
138− intercalate ", " replQueryStrings ++ ".")
139− Just query -> Right query
psci/Types.hsdeleted−170
@@ -1,170 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Types
4−-- Copyright : (c) Phil Freeman 2014
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Type declarations and associated basic functions for PSCI.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Types where
17−
18−import qualified Data.Map as M
19−import qualified Language.PureScript as P
20−
21−data PSCiOptions = PSCiOptions
22− { psciMultiLineMode :: Bool
23− , psciInputFile :: [FilePath]
24− , psciForeignInputFiles :: [FilePath]
25− , psciInputNodeFlags :: [String]
26− }
27−
28−-- |
29−-- The PSCI state.
30−-- Holds a list of imported modules, loaded files, and partial let bindings.
31−-- The let bindings are partial,
32−-- because it makes more sense to apply the binding to the final evaluated expression.
33−--
34−data PSCiState = PSCiState
35− { psciImportedFilenames :: [FilePath]
36− , psciImportedModules :: [ImportedModule]
37− , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
38− , psciForeignFiles :: M.Map P.ModuleName (FilePath, P.ForeignJS)
39− , psciLetBindings :: [P.Declaration]
40− , psciNodeFlags :: [String]
41− }
42−
43−-- | All of the data that is contained by an ImportDeclaration in the AST.
44−-- That is:
45−--
46−-- * A module name, the name of the module which is being imported
47−-- * An ImportDeclarationType which specifies whether there is an explicit
48−-- import list, a hiding list, or neither.
49−-- * If the module is imported qualified, its qualified name in the importing
50−-- module. Otherwise, Nothing.
51−--
52−type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)
53−
54−psciImportedModuleNames :: PSCiState -> [P.ModuleName]
55−psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
56− map (\(mn, _, _) -> mn) is
57−
58−allImportsOf :: P.Module -> PSCiState -> [ImportedModule]
59−allImportsOf m (PSCiState{psciImportedModules = is}) =
60− filter isImportOfThis is
61− where
62− name = P.getModuleName m
63− isImportOfThis (name', _, _) = name == name'
64−
65−-- State helpers
66−
67−-- |
68−-- Updates the state to have more imported modules.
69−--
70−updateImportedFiles :: FilePath -> PSCiState -> PSCiState
71−updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
72−
73−-- |
74−-- Updates the state to have more imported modules.
75−--
76−updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
77−updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
78−
79−-- |
80−-- Updates the state to have more loaded files.
81−--
82−updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
83−updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
84−
85−-- |
86−-- Updates the state to have more let bindings.
87−--
88−updateLets :: [P.Declaration] -> PSCiState -> PSCiState
89−updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
90−
91−-- |
92−-- Valid Meta-commands for PSCI
93−--
94−data Command
95− -- |
96− -- A purescript expression
97− --
98− = Expression P.Expr
99− -- |
100− -- Show the help (ie, list of directives)
101− --
102− | ShowHelp
103− -- |
104− -- Import a module from a loaded file
105− --
106− | Import ImportedModule
107− -- |
108− -- Browse a module
109− --
110− | BrowseModule P.ModuleName
111− -- |
112− -- Load a file for use with importing
113− --
114− | LoadFile FilePath
115− -- |
116− -- Exit PSCI
117− --
118− | QuitPSCi
119− -- |
120− -- Reset the state of the REPL
121− --
122− | ResetState
123− -- |
124− -- Add some declarations to the current evaluation context.
125− --
126− | Decls [P.Declaration]
127− -- |
128− -- Find the type of an expression
129− --
130− | TypeOf P.Expr
131− -- |
132− -- Find the kind of an expression
133− --
134− | KindOf P.Type
135− -- |
136− -- Shows information about the current state of the REPL
137− --
138− | ShowInfo ReplQuery
139−
140−data ReplQuery
141− = QueryLoaded
142− | QueryImport
143− deriving (Eq, Show)
144−
145−-- | A list of all ReplQuery values.
146−replQueries :: [ReplQuery]
147−replQueries = [QueryLoaded, QueryImport]
148−
149−replQueryStrings :: [String]
150−replQueryStrings = map showReplQuery replQueries
151−
152−showReplQuery :: ReplQuery -> String
153−showReplQuery QueryLoaded = "loaded"
154−showReplQuery QueryImport = "import"
155−
156−parseReplQuery :: String -> Maybe ReplQuery
157−parseReplQuery "loaded" = Just QueryLoaded
158−parseReplQuery "import" = Just QueryImport
159−parseReplQuery _ = Nothing
160−
161−data Directive
162− = Help
163− | Quit
164− | Reset
165− | Browse
166− | Load
167− | Type
168− | Kind
169− | Show
170− deriving (Eq, Show)
psci/main/Main.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−import PSCi
4−
5−main :: IO ()
6−main = runPSCi
psci/tests/Main.hsdeleted−141
@@ -1,141 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−
3−module Main where
4−
5−import Control.Monad.Trans.State.Strict (runStateT)
6−import Control.Monad (when)
7−
8−import Data.List (sort)
9−
10−import System.Exit (exitFailure)
11−import System.Console.Haskeline
12−import System.FilePath ((</>))
13−import System.Directory (getCurrentDirectory)
14−
15−import Test.HUnit
16−
17−import qualified Language.PureScript as P
18−
19−import PSCi
20−import Completion
21−import Types
22−
23−main :: IO ()
24−main = do
25− Counts{..} <- runTestTT allTests
26− when (errors + failures > 0) exitFailure
27−
28−allTests :: Test
29−allTests = completionTests
30−
31−completionTests :: Test
32−completionTests =
33− TestLabel "completionTests"
34− (TestList (map (TestCase . assertCompletedOk) completionTestData))
35−
36−-- If the cursor is at the right end of the line, with the 1st element of the
37−-- pair as the text in the line, then pressing tab should offer all the
38−-- elements of the list (which is the 2nd element) as completions.
39−completionTestData :: [(String, [String])]
40−completionTestData =
41− -- basic directives
42− [ (":h", [":help"])
43− , (":re", [":reset"])
44− , (":q", [":quit"])
45− , (":mo", [":module"])
46− , (":b", [":browse"])
47−
48− -- :browse should complete modules
49− , (":b Prel", [":b Prelude", ":b Prelude.Unsafe"])
50− , (":b Prelude.", [":b Prelude.Unsafe"])
51−
52− -- :load, :module should complete file paths
53− , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])
54− , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])
55−
56− -- :quit, :help, :reset should not complete
57− , (":help ", [])
58− , (":quit ", [])
59− , (":reset ", [])
60−
61− -- :show should complete to "loaded" and "import"
62− , (":show ", [":show import", ":show loaded"])
63− , (":show a", [])
64−
65− -- :type should complete values and data constructors in scope
66− , (":type Prelude.Unsafe.un", [":type Prelude.Unsafe.unsafeIndex"])
67− , (":type un", [":type unit"])
68− , (":type E", [":type EQ"])
69−
70− -- :kind should complete types in scope
71− , (":kind C", [":kind Control.Monad.Eff.Pure"])
72− , (":kind O", [":kind Ordering"])
73−
74− -- Only one argument for directives should be completed
75− , (":show import ", [])
76− , (":type EQ ", [])
77− , (":kind Ordering ", [])
78−
79− -- import should complete module names
80− , ("import Control.Monad.S", ["import Control.Monad.ST"])
81− , ("import qualified Control.Monad.S", ["import qualified Control.Monad.ST"])
82− , ("import Control.Monad.", map ("import Control.Monad." ++)
83− ["Eff", "ST"])
84−
85− -- a few other import tests
86− , ("impor", ["import"])
87− , ("import q", ["import qualified"])
88− , ("import ", map ("import " ++) allModuleNames ++ ["import qualified"])
89− , ("import Prelude.Unsafe ", [])
90−
91− -- String and number literals should not be completed
92− , ("\"hi", [])
93− , ("34", [])
94−
95− -- Identifiers and data constructors should be completed
96− , ("un", ["unit"])
97− , ("Debug.Trace.", map ("Debug.Trace." ++) ["print", "trace"])
98− , ("G", ["GT"])
99− , ("Prelude.L", ["Prelude.LT"])
100−
101− -- if a module is imported qualified, values should complete under the
102− -- qualified name, as well as the original name.
103− , ("ST.new", ["ST.newSTRef"])
104− , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
105− ]
106− where
107− allModuleNames = [ "Control.Monad.Eff"
108− , "Control.Monad.ST"
109− , "Data.Function"
110− , "Debug.Trace"
111− , "Prelude"
112− , "Prelude.Unsafe"
113− ]
114−
115−assertCompletedOk :: (String, [String]) -> Assertion
116−assertCompletedOk (line, expecteds) = do
117− (unusedR, completions) <- runCM (completion' (reverse line, ""))
118− let unused = reverse unusedR
119− let actuals = map ((unused ++) . replacement) completions
120− sort expecteds @=? sort actuals
121−
122−runCM :: CompletionM a -> IO a
123−runCM act = do
124− psciState <- getPSCiState
125− fmap fst (runStateT (liftCompletionM act) psciState)
126−
127−getPSCiState :: IO PSCiState
128−getPSCiState = do
129− cwd <- getCurrentDirectory
130− modulesOrFirstError <- loadAllModules [ cwd </> "tests" </> "prelude.purs" ]
131− case modulesOrFirstError of
132− Left err ->
133− print err >> exitFailure
134− Right modules ->
135− let imports = controlMonadSTasST : defaultImports
136− in return (PSCiState [] imports modules [] [])
137−
138−controlMonadSTasST :: ImportedModule
139−controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
140− where
141− s = P.moduleNameFromString
psci/tests/data/Sample.pursdeleted

No changes to the content.

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
purescript.cabaldeleted−237
@@ -1,237 +0,0 @@
1−name: purescript
2−version: 0.7.0.0
3−cabal-version: >=1.8
4−build-type: Simple
5−license: MIT
6−license-file: LICENSE
7−copyright: (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
8−maintainer: Phil Freeman <paf31@cantab.net>
9−stability: experimental
10−synopsis: PureScript Programming Language Compiler
11−description: A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to Javascript.
12−category: Language
13−Homepage: http://www.purescript.org/
14−author: Phil Freeman <paf31@cantab.net>,
15− Gary Burgess <gary.burgess@gmail.com>,
16− Hardy Jones <jones3.hardy@gmail.com>
17−
18−extra-source-files: examples/passing/*.purs
19− , examples/failing/*.purs
20−
21−source-repository head
22− type: git
23− location: https://github.com/purescript/purescript.git
24−
25−library
26− build-depends: base >=4.6 && <5,
27− containers -any,
28− unordered-containers -any,
29− dlist -any,
30− directory >= 1.2,
31− filepath -any,
32− mtl >= 2.1.0 && < 2.3.0,
33− parsec -any,
34− transformers >= 0.3.0 && < 0.5,
35− transformers-compat >= 0.3.0,
36− utf8-string >= 1 && < 2,
37− pattern-arrows >= 0.0.2 && < 0.1,
38− time -any,
39− boxes >= 0.1.4 && < 0.2.0,
40− aeson >= 0.8 && < 0.9,
41− vector -any,
42− bower-json >= 0.7,
43− aeson-better-errors >= 0.7,
44− bytestring -any,
45− text -any,
46− split -any
47−
48− exposed-modules: Language.PureScript
49− Language.PureScript.AST
50− Language.PureScript.AST.Binders
51− Language.PureScript.AST.Declarations
52− Language.PureScript.AST.Operators
53− Language.PureScript.AST.SourcePos
54− Language.PureScript.AST.Traversals
55− Language.PureScript.AST.Exported
56− Language.PureScript.CodeGen
57− Language.PureScript.CodeGen.Externs
58− Language.PureScript.CodeGen.JS
59− Language.PureScript.CodeGen.JS.AST
60− Language.PureScript.CodeGen.JS.Common
61− Language.PureScript.CodeGen.JS.Optimizer
62− Language.PureScript.CodeGen.JS.Optimizer.Blocks
63− Language.PureScript.CodeGen.JS.Optimizer.Common
64− Language.PureScript.CodeGen.JS.Optimizer.Inliner
65− Language.PureScript.CodeGen.JS.Optimizer.MagicDo
66− Language.PureScript.CodeGen.JS.Optimizer.TCO
67− Language.PureScript.CodeGen.JS.Optimizer.Unused
68− Language.PureScript.Constants
69− Language.PureScript.CoreFn
70− Language.PureScript.CoreFn.Ann
71− Language.PureScript.CoreFn.Binders
72− Language.PureScript.CoreFn.Desugar
73− Language.PureScript.CoreFn.Expr
74− Language.PureScript.CoreFn.Literals
75− Language.PureScript.CoreFn.Meta
76− Language.PureScript.CoreFn.Module
77− Language.PureScript.CoreFn.Traversals
78− Language.PureScript.Comments
79− Language.PureScript.DeadCodeElimination
80− Language.PureScript.Environment
81− Language.PureScript.Errors
82− Language.PureScript.Kinds
83− Language.PureScript.Linter
84− Language.PureScript.ModuleDependencies
85− Language.PureScript.Names
86− Language.PureScript.Options
87− Language.PureScript.Parser
88− Language.PureScript.Parser.Lexer
89− Language.PureScript.Parser.Common
90− Language.PureScript.Parser.Declarations
91− Language.PureScript.Parser.JS
92− Language.PureScript.Parser.Kinds
93− Language.PureScript.Parser.State
94− Language.PureScript.Parser.Types
95− Language.PureScript.Pretty
96− Language.PureScript.Pretty.Common
97− Language.PureScript.Pretty.JS
98− Language.PureScript.Pretty.Kinds
99− Language.PureScript.Pretty.Types
100− Language.PureScript.Pretty.Values
101− Language.PureScript.Renamer
102− Language.PureScript.Sugar
103− Language.PureScript.Sugar.BindingGroups
104− Language.PureScript.Sugar.CaseDeclarations
105− Language.PureScript.Sugar.DoNotation
106− Language.PureScript.Sugar.Names
107− Language.PureScript.Sugar.ObjectWildcards
108− Language.PureScript.Sugar.Operators
109− Language.PureScript.Sugar.TypeClasses
110− Language.PureScript.Sugar.TypeDeclarations
111− Language.PureScript.Traversals
112− Language.PureScript.TypeChecker
113− Language.PureScript.TypeChecker.Entailment
114− Language.PureScript.TypeChecker.Kinds
115− Language.PureScript.TypeChecker.Monad
116− Language.PureScript.TypeChecker.Rows
117− Language.PureScript.TypeChecker.Skolems
118− Language.PureScript.TypeChecker.Subsumption
119− Language.PureScript.TypeChecker.Synonyms
120− Language.PureScript.TypeChecker.Types
121− Language.PureScript.TypeChecker.Unify
122− Language.PureScript.TypeClassDictionaries
123− Language.PureScript.Types
124−
125− Language.PureScript.Docs
126− Language.PureScript.Docs.Render
127− Language.PureScript.Docs.Types
128− Language.PureScript.Docs.RenderedCode
129− Language.PureScript.Docs.RenderedCode.Types
130− Language.PureScript.Docs.RenderedCode.Render
131− Language.PureScript.Docs.AsMarkdown
132− Language.PureScript.Docs.ParseAndDesugar
133− Language.PureScript.Docs.Utils.MonoidExtras
134−
135− Control.Monad.Unify
136− Control.Monad.Supply
137− Control.Monad.Supply.Class
138−
139− exposed: True
140− buildable: True
141− hs-source-dirs: src
142− other-modules: Paths_purescript
143− ghc-options: -Wall -O2
144−
145−executable psc
146− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
147− mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
148− transformers -any
149− main-is: Main.hs
150− buildable: True
151− hs-source-dirs: psc
152− other-modules:
153− ghc-options: -Wall -O2 -fno-warn-unused-do-bind
154−
155−executable psc-make
156− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
157− mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
158− time -any, transformers -any, transformers-compat -any
159− main-is: Main.hs
160− buildable: True
161− hs-source-dirs: psc-make
162− other-modules:
163− ghc-options: -Wall -O2 -fno-warn-unused-do-bind
164−
165−executable psci
166− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
167− mtl -any, optparse-applicative >= 0.10.0, parsec -any,
168− haskeline >= 0.7.0.0, purescript -any, transformers -any,
169− transformers-compat -any, process -any, time -any
170−
171− main-is: Main.hs
172− buildable: True
173− hs-source-dirs: psci psci/main
174− other-modules: Types
175− Parser
176− Directive
177− Completion
178− PSCi
179− ghc-options: -Wall -O2
180−
181−executable psc-docs
182− build-depends: base >=4 && <5, purescript -any,
183− optparse-applicative >= 0.10.0, process -any, mtl -any,
184− split -any, ansi-wl-pprint -any, directory -any, filepath
185− -any
186− main-is: Main.hs
187− buildable: True
188− hs-source-dirs: psc-docs
189− other-modules: Ctags
190− Etags
191− Tags
192− ghc-options: -Wall -O2
193−
194−executable psc-publish
195− build-depends: base >=4 && <5, purescript -any,
196− optparse-applicative >= 0.10.0, process -any, mtl -any,
197− pattern-arrows -any, aeson -any, bytestring -any,
198− directory -any, transformers -any, text -any, containers
199− -any, boxes -any, split -any, Glob -any, aeson-better-errors
200− -any, transformers-compat -any, bower-json -any, semigroups
201− -any, safe -any
202− main-is: Main.hs
203− buildable: True
204− hs-source-dirs: psc-publish
205− other-modules: Utils
206− ErrorsWarnings
207− BoxesHelpers
208− ghc-options: -Wall -O2
209−
210−executable psc-hierarchy
211− build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
212− process -any, mtl -any, parsec -any, filepath -any, directory -any
213− main-is: Main.hs
214− buildable: True
215− hs-source-dirs: hierarchy
216− other-modules:
217− ghc-options: -Wall -O2
218−
219−test-suite tests
220− build-depends: base >=4 && <5, containers -any, directory -any,
221− filepath -any, mtl -any, parsec -any, purescript -any,
222− transformers -any, process -any
223− type: exitcode-stdio-1.0
224− main-is: Main.hs
225− buildable: True
226− hs-source-dirs: tests
227−
228−test-suite psci-tests
229− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
230− mtl -any, optparse-applicative >= 0.10.0, parsec -any,
231− haskeline >= 0.7.0.0, purescript -any, transformers -any,
232− transformers-compat -any, process -any, HUnit -any
233− type: exitcode-stdio-1.0
234− main-is: Main.hs
235− buildable: True
236− hs-source-dirs: psci psci/tests
237− ghc-options: -Wall
src/CodeGen/IL.hsnew file+321
@@ -0,0 +1,321 @@
1+-- | This module generates code in the core imperative representation from
2+-- elaborated PureScript code.
3+module CodeGen.IL
4+ ( module AST
5+ , module Common
6+ , moduleToIL
7+ ) where
8+
9+import Prelude.Compat
10+import Protolude (ordNub)
11+
12+import Control.Arrow ((&&&))
13+import Control.Monad (forM, liftM, replicateM, void)
14+import Control.Monad.Supply.Class
15+
16+import Data.List ((\\), delete, intersect, nub)
17+import qualified Data.Foldable as F
18+import qualified Data.Map as M
19+import Data.Maybe (fromMaybe, isNothing, mapMaybe)
20+import Data.Monoid ((<>))
21+import Data.String (fromString)
22+import Data.Text (Text)
23+import qualified Data.Text as T
24+
25+import Language.PureScript.AST.SourcePos
26+import Language.PureScript.CoreImp.AST (AST)
27+import qualified Language.PureScript.CoreImp.AST as AST
28+import Language.PureScript.CoreFn
29+import Language.PureScript.Crash
30+import Language.PureScript.Names
31+import Language.PureScript.Options
32+import Language.PureScript.PSString (PSString, mkString)
33+import Language.PureScript.Traversals (sndM)
34+import qualified Language.PureScript.Constants as C
35+
36+import System.FilePath.Posix ((</>))
37+
38+import CodeGen.IL.Common as Common
39+import CodeGen.IL.Optimizer
40+import CodeGen.IL.Printer
41+
42+data DeclType = ModuleDecl | LetDecl | RecLetDecl deriving (Eq)
43+
44+-- | Generate code in the simplified intermediate representation for all declarations in a
45+-- module.
46+moduleToIL
47+ :: forall m
48+ -- . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
49+ . (Monad m, MonadSupply m)
50+ => Module Ann
51+ -> Text
52+ -> m (Text, [Text], [AST], Text, Text)
53+moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
54+ do
55+ ilDecls <- mapM (bindToIL ModuleDecl) decls
56+ optimized <- traverse (traverse (optimize modName')) ilDecls
57+ let optimized' = concat optimized
58+ values = annotValue <$> optimized'
59+ foreigns' = moduleIdentToIL <$> foreigns
60+ interface = interfaceSource modName values foreigns
61+ imports = nub . concat $ importToIL <$> optimized'
62+ implHeader = implHeaderSource modName imports project
63+ implFooter = implFooterSource (runModuleName mn) foreigns
64+ return $ (interface, foreigns', optimized', implHeader, implFooter)
65+ where
66+ modName = moduleNameToIL mn
67+ modName' = AST.Var Nothing modName
68+
69+ annotValue :: AST -> (Text, Bool)
70+ annotValue (AST.Function _ (Just name) [] (AST.Block _ [AST.Return _ ret]))
71+ | isLiteral ret = (name, True)
72+ annotValue (AST.Function _ (Just name) [] _) = (name, False)
73+ annotValue _ = error "Unexpected top-level value form"
74+
75+ -- | Extracts all declaration names from a binding group.
76+ getNames :: Bind Ann -> [Ident]
77+ getNames (NonRec _ ident _) = [ident]
78+ getNames (Rec vals) = map (snd . fst) vals
79+
80+ -- | Generates IL code for a module import
81+ --
82+ importToIL :: AST -> [Text]
83+ importToIL = AST.everything (++) modRef
84+ where
85+ modRef (AST.Indexer _ (AST.Var _ _) (AST.Var _ mname))
86+ | not $ T.null mname = [extract mname]
87+ modRef _ = []
88+ extract :: Text -> Text
89+ extract = T.replace "_" "." . T.dropWhileEnd (=='_')
90+
91+ -- |
92+ -- Generate code in the simplified intermediate representation for a declaration
93+ --
94+ bindToIL :: DeclType -> Bind Ann -> m [AST]
95+ bindToIL dt (NonRec ann ident val) = return <$> nonRecToIL dt ann ident val
96+ bindToIL dt (Rec vals) = forM vals (uncurry . uncurry $ nonRecToIL dt')
97+ where
98+ dt' = if dt == LetDecl then RecLetDecl else dt
99+
100+ -- | Generate code in the simplified intermediate representation for a single non-recursive
101+ -- declaration.
102+ --
103+ -- The main purpose of this function is to handle code generation for comments.
104+ nonRecToIL :: DeclType -> Ann -> Ident -> Expr Ann -> m AST
105+ nonRecToIL dt a i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
106+ -- withoutComment <- asks optionsNoComments
107+ let withoutComment = False
108+ if withoutComment
109+ then nonRecToIL dt a i (modifyAnn removeComments e)
110+ else AST.Comment Nothing com <$> nonRecToIL dt a i (modifyAnn removeComments e)
111+ nonRecToIL ModuleDecl (ss, _, _, _) ident val = do
112+ il <- valueToIL val
113+ pure $ AST.Function Nothing (Just $ moduleIdentToIL ident) [] (AST.Block Nothing [AST.Return Nothing il])
114+ nonRecToIL RecLetDecl (ss, _, _, _) ident val = do
115+ ilExpr <- valueToIL val
116+ pure $ AST.Assignment Nothing (AST.Var Nothing $ identToIL ident) ilExpr
117+ nonRecToIL _ (ss, _, _, _) ident val = do
118+ il <- valueToIL val
119+ pure $ AST.VariableIntroduction Nothing (identToIL ident) (Just il)
120+
121+ -- | Generate code in the simplified intermediate representation for a variable based on a
122+ -- PureScript identifier.
123+ var :: Ident -> AST
124+ var = AST.Var Nothing . identToIL
125+
126+ accessorString :: PSString -> AST -> AST
127+ accessorString prop = AST.Indexer Nothing (AST.StringLiteral Nothing prop)
128+
129+ -- | Generate code in the simplified intermediate representation for a value or expression.
130+
131+ valueToIL :: Expr Ann -> m AST
132+ valueToIL (Literal (pos, _, _, _) l) = literalToValueIL pos l
133+ valueToIL (Accessor _ prop val) =
134+ accessorString prop <$> valueToIL val
135+ valueToIL (ObjectUpdate _ o ps) = do
136+ obj <- valueToIL o
137+ updates <- mapM (sndM valueToIL) ps
138+ obj' <- freshName'
139+ let objVar = AST.Var Nothing obj'
140+ copy = AST.VariableIntroduction Nothing obj' (Just $ copyDict obj)
141+ assign (k, v) = AST.Assignment Nothing (accessorString k objVar) v
142+ sts = copy : (assign <$> updates) ++ [AST.Return Nothing objVar]
143+ return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing sts)) []
144+ valueToIL (Abs _ arg val) = do
145+ ret <- valueToIL val
146+ let ilArg = case arg of
147+ UnusedIdent -> []
148+ _ -> [identToIL arg]
149+ return $ AST.Function Nothing Nothing ilArg (AST.Block Nothing [AST.Return Nothing ret])
150+ valueToIL e@App{} = do
151+ let (f, args) = unApp e []
152+ args' <- mapM valueToIL args
153+ fn <- valueToIL f
154+ case f of
155+ Var (_, _, _, Just IsNewtype) _ -> return (head args')
156+ _ -> flip (foldl (\fn a -> AST.App Nothing fn [a])) args' <$> valueToIL f
157+ where
158+ unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
159+ unApp (App _ val arg) args = unApp val (arg : args)
160+ unApp other args = (other, args)
161+ valueToIL (Var _ ident) = return $ varToIL ident
162+ valueToIL (Case (ss, _, _, _) values binders) = do
163+ vals <- mapM valueToIL values
164+ bindersToIL ss binders vals
165+ valueToIL (Let _ ds val) = do
166+ let recurs = concatMap getNames $ filter isRec ds
167+ recurDs = (\v -> AST.VariableIntroduction Nothing (identToIL v) Nothing) <$> recurs
168+ ds' <- concat <$> mapM (bindToIL LetDecl) ds
169+ ret <- valueToIL val
170+ return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (recurDs ++ ds' ++ [AST.Return Nothing ret]))) []
171+ where
172+ isRec :: Bind Ann -> Bool
173+ isRec (Rec _) = True
174+ isRec _ = False
175+ valueToIL (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) = error "IsNewtype"
176+ valueToIL (Constructor _ _ (ProperName ctor) fields) =
177+ let body = AST.ObjectLiteral Nothing $ (mkString ctor, AST.BooleanLiteral Nothing True) :
178+ ((\field -> (mkString (identToIL field), var field)) `map` fields)
179+ fn = foldr (\f inner -> AST.Function Nothing Nothing [identToIL f] (AST.Block Nothing [AST.Return Nothing inner])) body fields
180+ in return fn
181+
182+
183+ iife :: Text -> [AST] -> AST
184+ iife v exprs = AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing $ exprs ++ [AST.Return Nothing $ AST.Var Nothing v])) []
185+
186+ literalToValueIL :: SourceSpan -> Literal (Expr Ann) -> m AST
187+ literalToValueIL ss (NumericLiteral (Left i)) = return $ AST.NumericLiteral (Just ss) (Left i)
188+ literalToValueIL ss (NumericLiteral (Right n)) = return $ AST.NumericLiteral (Just ss) (Right n)
189+ literalToValueIL ss (StringLiteral s) = return $ AST.StringLiteral (Just ss) s
190+ literalToValueIL ss (CharLiteral c) = return $ AST.StringLiteral (Just ss) (fromString [c])
191+ literalToValueIL ss (BooleanLiteral b) = return $ AST.BooleanLiteral (Just ss) b
192+ literalToValueIL ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToIL xs
193+ literalToValueIL ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToIL) ps
194+
195+ -- | Generate code in the simplified intermediate representation for a reference to a
196+ -- variable.
197+ varToIL :: Qualified Ident -> AST
198+ varToIL (Qualified Nothing ident) = var ident
199+ varToIL qual = qualifiedToIL id qual
200+
201+ -- | Generate code in the simplified intermediate representation for a reference to a
202+ -- variable that may have a qualified name.
203+ qualifiedToIL :: (a -> Ident) -> Qualified a -> AST
204+ qualifiedToIL f (Qualified (Just (ModuleName mn')) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a
205+ qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))
206+ qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")
207+
208+ -- foreignIdent :: Ident -> AST
209+ -- foreignIdent ident = accessorString (mkString $ runIdent ident) (AST.Var Nothing "$foreign")
210+
211+ -- | Generate code in the simplified intermediate representation for pattern match binders
212+ -- and guards.
213+ bindersToIL :: SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST
214+ bindersToIL ss binders vals = do
215+ valNames <- replicateM (length vals) freshName'
216+ let assignments = zipWith (AST.VariableIntroduction Nothing) valNames (map Just vals)
217+ ils <- forM binders $ \(CaseAlternative bs result) -> do
218+ ret <- guardsToIL result
219+ go valNames ret bs
220+ return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (assignments ++ concat ils ++ [AST.Throw Nothing (AST.StringLiteral Nothing $ mkString failedPatternMessage)])))
221+ []
222+ where
223+ go :: [Text] -> [AST] -> [Binder Ann] -> m [AST]
224+ go _ done [] = return done
225+ go (v:vs) done' (b:bs) = do
226+ done'' <- go vs done' bs
227+ binderToIL v done'' b
228+ go _ _ _ = internalError "Invalid arguments to bindersToIL"
229+
230+ failedPatternMessage :: Text
231+ failedPatternMessage = "Failed pattern match at " <> runModuleName mn <> " " <> displayStartEndPos ss
232+
233+ guardsToIL :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [AST]
234+ guardsToIL (Left gs) = traverse genGuard gs where
235+ genGuard (cond, val) = do
236+ cond' <- valueToIL cond
237+ val' <- valueToIL val
238+ return
239+ (AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo cond' (AST.BooleanLiteral Nothing True))
240+ (AST.Block Nothing [AST.Return Nothing val']) Nothing)
241+
242+ guardsToIL (Right v) = return . AST.Return Nothing <$> valueToIL v
243+
244+ -- | Generate code in the simplified intermediate representation for a pattern match
245+ -- binder.
246+ binderToIL :: Text -> [AST] -> Binder Ann -> m [AST]
247+ binderToIL _ done NullBinder{} = return done
248+ binderToIL varName done (LiteralBinder _ l) =
249+ literalToBinderIL varName done l
250+ binderToIL varName done (VarBinder _ ident) =
251+ return (AST.VariableIntroduction Nothing (identToIL ident) (Just (AST.Var Nothing varName)) : done)
252+ binderToIL varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
253+ binderToIL varName done b
254+ binderToIL varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ (Qualified _ (ProperName ctor)) bs) = do
255+ il <- go (zip fields bs) done
256+ return $ case ctorType of
257+ ProductType -> il
258+ SumType ->
259+ [AST.IfElse Nothing (AST.InstanceOf Nothing (AST.Var Nothing varName) (AST.StringLiteral Nothing (mkString ctor)))
260+ (AST.Block Nothing il)
261+ Nothing]
262+ where
263+ go :: [(Ident, Binder Ann)] -> [AST] -> m [AST]
264+ go [] done' = return done'
265+ go ((field, binder) : remain) done' = do
266+ argVar <- freshName'
267+ done'' <- go remain done'
268+ il <- binderToIL argVar done'' binder
269+ return (AST.VariableIntroduction Nothing argVar (Just $ accessorString (mkString $ identToIL field) $ AST.Var Nothing varName) : il)
270+
271+ binderToIL _ _ ConstructorBinder{} =
272+ internalError "binderToIL: Invalid ConstructorBinder in binderToIL"
273+ binderToIL varName done (NamedBinder _ ident binder) = do
274+ il <- binderToIL varName done binder
275+ return (AST.VariableIntroduction Nothing (identToIL ident) (Just (AST.Var Nothing varName)) : il)
276+
277+ literalToBinderIL :: Text -> [AST] -> Literal (Binder Ann) -> m [AST]
278+ literalToBinderIL varName done (NumericLiteral num) =
279+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.NumericLiteral Nothing num)) (AST.Block Nothing done) Nothing]
280+ literalToBinderIL varName done (CharLiteral c) =
281+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing (fromString [c]))) (AST.Block Nothing done) Nothing]
282+ literalToBinderIL varName done (StringLiteral str) =
283+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing str)) (AST.Block Nothing done) Nothing]
284+ literalToBinderIL varName done (BooleanLiteral True) =
285+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.BooleanLiteral Nothing True)) (AST.Block Nothing done) Nothing]
286+ literalToBinderIL varName done (BooleanLiteral False) =
287+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.BooleanLiteral Nothing False)) (AST.Block Nothing done) Nothing]
288+ -- return [AST.IfElse Nothing (AST.Unary Nothing AST.Not (AST.Var Nothing varName)) (AST.Block Nothing done) Nothing]
289+ literalToBinderIL varName done (ObjectLiteral bs) = go done bs
290+ where
291+ go :: [AST] -> [(PSString, Binder Ann)] -> m [AST]
292+ go done' [] = return done'
293+ go done' ((prop, binder):bs') = do
294+ propVar <- freshName'
295+ done'' <- go done' bs'
296+ il <- binderToIL propVar done'' binder
297+ return (AST.VariableIntroduction Nothing propVar (Just (accessorString prop (AST.Var Nothing varName))) : il)
298+ literalToBinderIL varName done (ArrayLiteral bs) = do
299+ il <- go done 0 bs
300+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo
301+ (arrayLength $ AST.Var Nothing varName)
302+ (AST.NumericLiteral Nothing (Left (fromIntegral $ length bs))))
303+ (AST.Block Nothing il) Nothing]
304+ where
305+ go :: [AST] -> Integer -> [Binder Ann] -> m [AST]
306+ go done' _ [] = return done'
307+ go done' index (binder:bs') = do
308+ elVar <- freshName'
309+ done'' <- go done' (index + 1) bs'
310+ il <- binderToIL elVar done'' binder
311+ return (AST.VariableIntroduction Nothing elVar (Just (AST.Indexer Nothing (AST.NumericLiteral Nothing (Left index)) (AST.Var Nothing varName))) : il)
312+
313+emptyAnn :: Ann
314+emptyAnn = (SourceSpan "" (SourcePos 0 0) (SourcePos 0 0), [], Nothing, Nothing)
315+
316+arrayLength :: AST -> AST
317+arrayLength a = AST.App Nothing (AST.Var Nothing arrayLengthFn) [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.hsnew file+196
@@ -0,0 +1,196 @@
1+-- | Common code generation utility functions
2+module CodeGen.IL.Common where
3+
4+import Prelude.Compat
5+
6+import Control.Monad.Supply.Class (MonadSupply, freshName)
7+import Data.Char
8+import Data.Maybe (maybe)
9+import Data.Monoid ((<>))
10+import Data.Text (Text)
11+import qualified Data.Text as T
12+
13+import Language.PureScript.Crash
14+import Language.PureScript.Names
15+
16+import qualified Language.PureScript.Constants as C
17+
18+moduleNameToIL :: ModuleName -> Text
19+moduleNameToIL (ModuleName mn) =
20+ let name = T.replace "." "_" mn
21+ in if nameIsILBuiltIn name then (name <> moduleRenamerMarker) else name
22+
23+moduleNameToIL' :: ModuleName -> Text
24+moduleNameToIL' (ModuleName mn) = T.replace "_" "." mn
25+
26+-- | Convert an 'Ident' into a valid IL identifier:
27+--
28+-- * Alphanumeric characters are kept unmodified.
29+--
30+-- * Reserved IL identifiers are wrapped with '_'.
31+--
32+identToIL :: Ident -> Text
33+identToIL UnusedIdent = unusedName
34+identToIL (Ident "$__unused") = unusedName
35+identToIL (Ident name) | name == C.undefined = undefinedName -- Note: done in Printer.hs too
36+identToIL (Ident name) = properToIL name
37+identToIL (GenIdent _ _) = internalError "GenIdent in identToIL"
38+
39+moduleIdentToIL :: Ident -> Text
40+moduleIdentToIL UnusedIdent = unusedName
41+moduleIdentToIL (Ident name) | name == C.undefined = undefinedName
42+moduleIdentToIL (Ident name) = moduleProperToIL name
43+moduleIdentToIL (GenIdent _ _) = internalError "GenIdent in identToIL"
44+
45+undefinedName :: Text
46+undefinedName = "Undefined"
47+
48+unusedName :: Text
49+unusedName = "_"
50+
51+properToIL :: Text -> Text
52+properToIL name
53+ | nameIsILReserved name = "ˉ" <> name
54+ | otherwise = T.concatMap identCharToText name
55+
56+-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the
57+-- ordinal value.
58+identCharToText :: Char -> Text
59+identCharToText 'ṩ' = "_ṩ"
60+identCharToText c | isAlphaNum c = T.singleton c
61+identCharToText '_' = "_"
62+identCharToText '\'' = "ꞌ" -- lowercase saltillo
63+identCharToText c = error (show (ord c)) -- TODO: should never occur now(?)
64+
65+moduleProperToIL :: Text -> Text
66+moduleProperToIL = T.concatMap identCharToText
67+
68+-- | Checks whether an identifier name is reserved in IL.
69+nameIsILReserved :: Text -> Bool
70+nameIsILReserved name =
71+ name `elem` ilAnyReserved
72+
73+-- | Checks whether a name matches a built-in value in IL.
74+nameIsILBuiltIn :: Text -> Bool
75+nameIsILBuiltIn name =
76+ name `elem`
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"
92+ ]
93+
94+ilAnyReserved :: [Text]
95+ilAnyReserved =
96+ concat
97+ [ ilKeywords
98+ , ilLiterals
99+ ]
100+
101+ilKeywords :: [Text]
102+ilKeywords =
103+ [ "break"
104+ , "case"
105+ , "chan"
106+ , "const"
107+ , "continue"
108+ , "default"
109+ , "defer"
110+ , "else"
111+ , "fallthrough"
112+ , "for"
113+ , "func"
114+ , "go"
115+ , "goto"
116+ , "if"
117+ , "import"
118+ , "interface"
119+ , "map"
120+ , "package"
121+ , "range"
122+ , "return"
123+ , "select"
124+ , "struct"
125+ , "switch"
126+ , "type"
127+ , "var"
128+ ]
129+
130+ilLiterals :: [Text]
131+ilLiterals =
132+ [ "init"
133+ , "nil"
134+ , "int"
135+ , "int8"
136+ , "int16"
137+ , "int32"
138+ , "int64"
139+ , "uint"
140+ , "uint8"
141+ , "uint16"
142+ , "uint32"
143+ , "uint64"
144+ , "uintptr"
145+ , "float32"
146+ , "float64"
147+ , "complex64"
148+ , "complex128"
149+ , "byte"
150+ , "rune"
151+ , "string"
152+ ]
153+
154+withPrefix :: Text -> Text
155+withPrefix s = "Ꞌ" <> s -- uppercase saltillo
156+
157+anyType :: Text
158+anyType = "Any"
159+
160+dictType :: Text
161+dictType = "Dict"
162+
163+arrayType :: Text
164+arrayType = "[]" <> anyType
165+
166+uncurriedFnType :: Int -> Text
167+uncurriedFnType i = "Fn" <> (T.pack . show $ i)
168+
169+int :: Text
170+int = "int"
171+
172+float :: Text
173+float = "float64"
174+
175+bool :: Text
176+bool = "bool"
177+
178+string :: Text
179+string = "string"
180+
181+arrayLengthFn :: Text
182+arrayLengthFn = "Length"
183+
184+indexFn :: Text
185+indexFn = "Index"
186+
187+copyDictFn :: Text
188+copyDictFn = "CopyDict"
189+
190+freshName' :: MonadSupply m => m Text
191+freshName' = do
192+ name <- freshName
193+ return $ T.replace "$" "ṩ" name
194+
195+moduleRenamerMarker :: Text
196+moduleRenamerMarker = "__"
src/CodeGen/IL/Optimizer.hsnew file+81
@@ -0,0 +1,81 @@
1+-- | This module optimizes code in the intermediate representation.
2+module CodeGen.IL.Optimizer (optimize) where
3+
4+import Prelude.Compat
5+
6+import Control.Monad.Supply.Class (MonadSupply)
7+import Data.Text (Text)
8+import Language.PureScript.CoreImp.AST
9+import Language.PureScript.CoreImp.Optimizer.Blocks
10+import Language.PureScript.CoreImp.Optimizer.Common hiding (isDict)
11+import Language.PureScript.CoreImp.Optimizer.Inliner (etaConvert, evaluateIifes, inlineVariables, unThunk)
12+import Language.PureScript.CoreImp.Optimizer.Unused
13+
14+import CodeGen.IL.Common (unusedName)
15+import CodeGen.IL.Optimizer.Inliner
16+import CodeGen.IL.Optimizer.MagicDo
17+import CodeGen.IL.Optimizer.TCO
18+
19+import qualified Language.PureScript.Constants as C
20+
21+-- | Apply a series of optimizer passes to simplified IL code
22+optimize :: MonadSupply m => AST -> AST -> m AST
23+optimize mn il = do
24+ il' <- untilFixedPoint (inlineFnComposition . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp) il
25+ il'' <- untilFixedPoint (return . ignoreUnusedResults . inlineCommonValues . inlineCommonOperators . tidyUp) . tco mn . inlineST
26+ =<< untilFixedPoint (return . magicDoST)
27+ =<< untilFixedPoint (return . magicDoEff)
28+ =<< untilFixedPoint (return . magicDoEffect) il'
29+ untilFixedPoint (return . collapseVarDeclarations) il''
30+ where
31+ tidyUp :: AST -> AST
32+ tidyUp = applyAll
33+ [ collapseNestedBlocks
34+ , collapseNestedIfs
35+ , collapseIfChecks
36+ , removeCodeAfterReturnStatements
37+ , unThunk
38+ , etaConvert
39+ , evaluateIifes
40+ , inlineVariables
41+ ]
42+
43+untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
44+untilFixedPoint f = go
45+ where
46+ go a = do
47+ a' <- f a
48+ if a' == a then return a' else go a'
49+
50+collapseIfChecks :: AST -> AST
51+collapseIfChecks = everywhere collapse where
52+ collapse :: AST -> AST
53+ collapse (IfElse _ (Binary _ EqualTo (BooleanLiteral _ True) (BooleanLiteral _ True)) (Block _ [exprs]) _) = exprs
54+ collapse (IfElse _ (Binary _ EqualTo (Indexer _ (Var _ prop) (Var _ val)) (BooleanLiteral _ True)) (Block _ [exprs]) _)
55+ | prop == "otherwise" && val == "Data_Boolean" = exprs
56+ collapse exprs = exprs
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
70+
71+ignoreUnusedResults :: AST -> AST
72+ignoreUnusedResults = everywhere $ removeFromBlock go
73+ where
74+ go :: [AST] -> [AST]
75+ go [] = []
76+ go (VariableIntroduction ss var (Just s) : sts)
77+ | not $ any (everything (||) (isUsed var)) sts = sts'
78+ where
79+ sts' | App{} <- s = s : (go sts)
80+ | otherwise = go sts
81+ go (s:sts) = s : go sts
src/CodeGen/IL/Optimizer/Common.hsnew file+18
@@ -0,0 +1,18 @@
1+-- | Common functions used by the various optimizer phases
2+module CodeGen.IL.Optimizer.Common where
3+
4+import Prelude.Compat
5+
6+import Data.Text (Text)
7+
8+import Language.PureScript.CoreImp.AST
9+import Language.PureScript.PSString (PSString, decodeString)
10+
11+isDict :: (Text, PSString) -> AST -> Bool
12+isDict (moduleName, dictName) (Indexer _ (Var _ x) (Var _ y)) =
13+ Just x == decodeString dictName && y == moduleName
14+isDict _ _ = False
15+
16+isDict' :: [(Text, PSString)] -> AST -> Bool
17+isDict' xs il = any (`isDict` il) xs
18+
src/CodeGen/IL/Optimizer/Inliner.hsnew file+435
@@ -0,0 +1,435 @@
1+-- | This module performs basic inlining of known functions
2+module CodeGen.IL.Optimizer.Inliner
3+ ( inlineCommonValues
4+ , inlineCommonOperators
5+ , inlineFnComposition
6+ , inlineUnsafeCoerce
7+ , inlineUnsafePartial
8+ ) where
9+
10+import Prelude.Compat
11+
12+import Control.Monad.Supply.Class (MonadSupply)
13+
14+import Data.Either (rights)
15+import Data.Maybe (fromMaybe)
16+import Data.String (IsString, fromString)
17+import Data.Text (Text)
18+import qualified Data.Text as T
19+
20+import Language.PureScript.PSString (PSString, decodeString, mkString)
21+import Language.PureScript.CoreImp.AST
22+import Language.PureScript.CoreImp.Optimizer.Common hiding (isDict, isDict')
23+import Language.PureScript.AST (SourceSpan(..))
24+import qualified Language.PureScript.Constants as C
25+
26+import CodeGen.IL.Common
27+import CodeGen.IL.Optimizer.Common
28+
29+-- TODO: Potential bug:
30+-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
31+-- Needs to be: { 0..toFixed(10); }
32+-- Probably needs to be fixed in pretty-printer instead.
33+shouldInline :: AST -> Bool
34+shouldInline (Var _ _) = True
35+shouldInline (NumericLiteral _ _) = True
36+shouldInline (StringLiteral _ _) = True
37+shouldInline (BooleanLiteral _ _) = True
38+shouldInline (Indexer _ index val) = shouldInline index && shouldInline val
39+shouldInline _ = False
40+
41+inlineCommonValues :: AST -> AST
42+inlineCommonValues = everywhere convert
43+ where
44+ convert :: AST -> AST
45+ convert (App ss fn [dict])
46+ | isDict' [semiringNumber, semiringInt] dict && isDict fnZero fn = NumericLiteral ss (Left 0)
47+ | isDict' [semiringNumber, semiringInt] dict && isDict fnOne fn = NumericLiteral ss (Left 1)
48+ | isDict boundedBoolean dict && isDict fnBottom fn = BooleanLiteral ss False
49+ | isDict boundedBoolean dict && isDict fnTop fn = BooleanLiteral ss True
50+ convert (App ss (App _ fn [dict]) [x])
51+ | isDict ringInt dict && isDict fnNegate fn = Unary ss Negate (unbox x $ snd ringInt)
52+ convert (App ss (App _ (App _ fn [dict]) [x]) [y])
53+ | isDict semiringInt dict && isDict fnAdd fn = intOp ss Add semiringInt x y
54+ | isDict semiringInt dict && isDict fnMultiply fn = intOp ss Multiply semiringInt x y
55+ | isDict ringInt dict && isDict fnSubtract fn = intOp ss Subtract ringInt x y
56+ convert other = other
57+ fnZero = (C.dataSemiring, C.zero)
58+ fnOne = (C.dataSemiring, C.one)
59+ fnBottom = (C.dataBounded, C.bottom)
60+ fnTop = (C.dataBounded, C.top)
61+ fnAdd = (C.dataSemiring, C.add)
62+ fnMultiply = (C.dataSemiring, C.mul)
63+ fnSubtract = (C.dataRing, C.sub)
64+ fnNegate = (C.dataRing, C.negate)
65+ intOp ss op (_, d) x y = Binary ss op (unbox x d) (unbox y d)
66+
67+inlineCommonOperators :: AST -> AST
68+inlineCommonOperators = everywhereTopDown $ applyAll $
69+ [ binary semiringNumber opAdd Add
70+ , binary semiringNumber opMul Multiply
71+
72+ , binary ringNumber opSub Subtract
73+ , unary ringNumber opNegate Negate
74+
75+ , binary euclideanRingNumber opDiv Divide
76+
77+ -- , binary eqNumber opEq EqualTo
78+ -- , binary eqNumber opNotEq NotEqualTo
79+ , binary eqInt opEq EqualTo
80+ , binary eqInt opNotEq NotEqualTo
81+ , binary eqString opEq EqualTo
82+ , binary eqString opNotEq NotEqualTo
83+ , binary eqChar opEq EqualTo
84+ , binary eqChar opNotEq NotEqualTo
85+ , binary eqBoolean opEq EqualTo
86+ , binary eqBoolean opNotEq NotEqualTo
87+
88+ , binary ordBoolean opLessThan LessThan
89+ , binary ordBoolean opLessThanOrEq LessThanOrEqualTo
90+ , binary ordBoolean opGreaterThan GreaterThan
91+ , binary ordBoolean opGreaterThanOrEq GreaterThanOrEqualTo
92+ , binary ordChar opLessThan LessThan
93+ , binary ordChar opLessThanOrEq LessThanOrEqualTo
94+ , binary ordChar opGreaterThan GreaterThan
95+ , binary ordChar opGreaterThanOrEq GreaterThanOrEqualTo
96+ , binary ordInt opLessThan LessThan
97+ , binary ordInt opLessThanOrEq LessThanOrEqualTo
98+ , binary ordInt opGreaterThan GreaterThan
99+ , binary ordInt opGreaterThanOrEq GreaterThanOrEqualTo
100+ , binary ordNumber opLessThan LessThan
101+ , binary ordNumber opLessThanOrEq LessThanOrEqualTo
102+ , binary ordNumber opGreaterThan GreaterThan
103+ , binary ordNumber opGreaterThanOrEq GreaterThanOrEqualTo
104+ , binary ordString opLessThan LessThan
105+ , binary ordString opLessThanOrEq LessThanOrEqualTo
106+ , binary ordString opGreaterThan GreaterThan
107+ , binary ordString opGreaterThanOrEq GreaterThanOrEqualTo
108+
109+ , binary semigroupString opAppend Add
110+
111+ , binary heytingAlgebraBoolean opConj And
112+ , binary heytingAlgebraBoolean opDisj Or
113+ , unary heytingAlgebraBoolean opNot Not
114+
115+ , binary' C.dataIntBits C.or BitwiseOr
116+ , binary' C.dataIntBits C.and BitwiseAnd
117+ , binary' C.dataIntBits C.xor BitwiseXor
118+ , binary' C.dataIntBits C.shl ShiftLeft
119+ , binary' C.dataIntBits C.shr ShiftRight
120+ , unary' C.dataIntBits C.complement BitwiseNot
121+
122+ , inlineNonClassFunction (isModFn (C.dataFunction, C.apply)) $ \f x -> App Nothing f [x]
123+ , inlineNonClassFunction (isModFn (C.dataFunction, C.applyFlipped)) $ \x f -> App Nothing f [x]
124+ , inlineUnsafeIndex (isModFnWithDict (C.dataArray, C.unsafeIndex)) $ flip (Indexer Nothing)
125+ ] ++
126+ [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ] ++
127+ [ fn | i <- [0..10], fn <- [ mkEffFn C.controlMonadEffUncurried C.mkEffFn i, runEffFn C.controlMonadEffUncurried C.runEffFn i ] ] ++
128+ [ fn | i <- [0..10], fn <- [ mkEffFn C.effectUncurried C.mkEffectFn i, runEffFn C.effectUncurried C.runEffectFn i ] ]
129+ where
130+ binary :: (Text, PSString) -> (Text, PSString) -> BinaryOperator -> AST -> AST
131+ binary dict@(_, d) fns op = convert where
132+ convert :: AST -> AST
133+ convert (App ss (App _ (App _ fn [dict']) [x]) [y])
134+ | isDict dict dict' && isDict fns fn = Binary ss op (unbox x d) (unbox y d)
135+ convert other = other
136+ binary' :: Text -> PSString -> BinaryOperator -> AST -> AST
137+ binary' moduleName opString op = convert where
138+ convert :: AST -> AST
139+ convert (App ss (App _ fn [x]) [y]) | isDict (moduleName, opString) fn = Binary ss op (unbox x mn) (unbox y mn)
140+ convert other = other
141+ mn :: PSString
142+ mn = mkString moduleName
143+ unary :: (Text, PSString) -> (Text, PSString) -> UnaryOperator -> AST -> AST
144+ unary dicts@(_, d) fns op = convert where
145+ convert :: AST -> AST
146+ convert (App ss (App _ fn [dict']) [x]) | isDict dicts dict' && isDict fns fn = Unary ss op (unbox x d)
147+ convert other = other
148+ unary' :: Text -> PSString -> UnaryOperator -> AST -> AST
149+ unary' moduleName fnName op = convert where
150+ convert :: AST -> AST
151+ convert (App ss fn [x]) | isDict (moduleName, fnName) fn = Unary ss op (unbox x fnName)
152+ convert other = other
153+
154+ mkFn :: Int -> AST -> AST
155+ mkFn = mkFn' C.dataFunctionUncurried C.mkFn $ \ss1 ss2 ss3 args il ->
156+ Function ss1 Nothing args (Block ss2 [Return ss3 il])
157+
158+ mkEffFn :: Text -> Text -> Int -> AST -> AST
159+ mkEffFn modName fnName = mkFn' modName fnName $ \ss1 ss2 ss3 args il ->
160+ Function ss1 Nothing args (Block ss2 [Return ss3 (App ss3 il [])])
161+
162+ mkFn' :: Text -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST
163+ mkFn' modName fnName res 0 = convert where
164+ convert :: AST -> AST
165+ convert (App _ mkFnN [Function s1 Nothing [_] (Block s2 [Return s3 il])]) | isNFn modName fnName 0 mkFnN =
166+ res s1 s2 s3 [] il
167+ convert other = other
168+ mkFn' modName fnName res n = convert where
169+ convert :: AST -> AST
170+ convert orig@(App ss mkFnN [fn]) | isNFn modName fnName n mkFnN =
171+ case collectArgs n [] fn of
172+ Just (args, [Return ss' ret]) -> res ss ss ss' args ret
173+ _ -> orig
174+ convert other = other
175+ collectArgs :: Int -> [Text] -> AST -> Maybe ([Text], [AST])
176+ collectArgs 1 acc (Function _ Nothing [oneArg] (Block _ il)) | length acc == n - 1 = Just (reverse (oneArg : acc), il)
177+ collectArgs m acc (Function _ Nothing [oneArg] (Block _ [Return _ ret])) = collectArgs (m - 1) (oneArg : acc) ret
178+ collectArgs _ _ _ = Nothing
179+
180+ isNFn :: Text -> Text -> Int -> AST -> Bool
181+ isNFn expectMod prefix n (Indexer _ (Var _ name) (Var _ modName)) | modName == expectMod =
182+ name == fromString (T.unpack prefix <> show n)
183+ isNFn _ _ _ _ = False
184+
185+ runFn :: Int -> AST -> AST
186+ runFn = runFn' C.dataFunctionUncurried C.runFn (\ss f args ->
187+ let len = length args
188+ typ = mkString $ uncurriedFnType len in
189+ if len > 0
190+ then App ss (App Nothing (StringLiteral Nothing typ) [f]) args
191+ else App ss f args)
192+ runEffFn :: Text -> Text -> Int -> AST -> AST
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 (App Nothing (StringLiteral Nothing typ) [fn]) acc)])
196+
197+ runFn' :: Text -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
198+ runFn' modName runFnName res n = convert where
199+ convert :: AST -> AST
200+ convert il = fromMaybe il $ go n [] il
201+
202+ go :: Int -> [AST] -> AST -> Maybe AST
203+ go 0 acc (App ss runFnN [fn]) | isNFn modName runFnName n runFnN && length acc == n =
204+ Just $ res ss fn acc
205+ go m acc (App _ lhs [arg]) = go (m - 1) (arg : acc) lhs
206+ go _ _ _ = Nothing
207+
208+ inlineNonClassFunction :: (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
209+ inlineNonClassFunction p f = convert where
210+ convert :: AST -> AST
211+ convert (App _ (App _ op' [x]) [y]) | p op' = f x y
212+ convert other = other
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+
223+ isModFn :: (Text, PSString) -> AST -> Bool
224+ isModFn (m, op) (Indexer _ (Var _ op') (Var _ m')) =
225+ m == m' && decodeString op == Just op'
226+ isModFn _ _ = False
227+
228+ isModFnWithDict :: (Text, PSString) -> AST -> Bool
229+ isModFnWithDict (m, op) (App _ (Indexer _ (Var _ op') (Var _ m')) [Var _ _]) =
230+ m == m' && decodeString op == Just op'
231+ isModFnWithDict _ _ = False
232+
233+-- (f <<< g $ x) = f (g x)
234+-- (f <<< g) = \x -> f (g x)
235+inlineFnComposition :: forall m. MonadSupply m => AST -> m AST
236+inlineFnComposition = everywhereTopDownM convert where
237+ convert :: AST -> m AST
238+ convert (App s1 (App s2 (App _ (App _ fn [dict']) [x]) [y]) [z])
239+ | isFnCompose dict' fn = return $ App s1 x [App s2 y [z]]
240+ | isFnComposeFlipped dict' fn = return $ App s2 y [App s1 x [z]]
241+ convert app@(App ss (App _ (App _ fn [dict']) _) _)
242+ | isFnCompose dict' fn || isFnComposeFlipped dict' fn = mkApps ss <$> goApps app <*> freshName'
243+ convert other = return other
244+
245+ mkApps :: Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST
246+ mkApps ss fns a = App ss (Function ss Nothing [] (Block ss $ vars <> [Return Nothing comp])) []
247+ where
248+ vars = uncurry (VariableIntroduction ss) . fmap Just <$> rights fns
249+ comp = Function ss Nothing [a] (Block ss [Return Nothing apps])
250+ apps = foldr (\fn acc -> App ss (mkApp fn) [acc]) (Var ss a) fns
251+
252+ mkApp :: Either AST (Text, AST) -> AST
253+ mkApp = either id $ \(name, arg) -> Var (getSourceSpan arg) name
254+
255+ goApps :: AST -> m [Either AST (Text, AST)]
256+ goApps (App _ (App _ (App _ fn [dict']) [x]) [y])
257+ | isFnCompose dict' fn = mappend <$> goApps x <*> goApps y
258+ | isFnComposeFlipped dict' fn = mappend <$> goApps y <*> goApps x
259+ goApps app@(App {}) = pure . Right . (,app) <$> freshName'
260+ goApps other = pure [Left other]
261+
262+ isFnCompose :: AST -> AST -> Bool
263+ isFnCompose dict' fn = isDict semigroupoidFn dict' && isDict fnCompose fn
264+
265+ isFnComposeFlipped :: AST -> AST -> Bool
266+ isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isDict fnComposeFlipped fn
267+
268+ fnCompose :: forall a b. (IsString a, IsString b) => (a, b)
269+ fnCompose = (C.controlSemigroupoid, C.compose)
270+
271+ fnComposeFlipped :: forall a b. (IsString a, IsString b) => (a, b)
272+ fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)
273+
274+inlineUnsafeCoerce :: AST -> AST
275+inlineUnsafeCoerce = everywhereTopDown convert where
276+ convert (App _ (Indexer _ (Var _ unsafeCoerceFn) (Var _ unsafeCoerce)) [ comp ])
277+ | unsafeCoerceFn == C.unsafeCoerceFn && unsafeCoerce == C.unsafeCoerce
278+ = comp
279+ convert other = other
280+
281+inlineUnsafePartial :: AST -> AST
282+inlineUnsafePartial = everywhereTopDown convert where
283+ convert (App ss fn [ comp ])
284+ | isDict fnUnsafePartial fn
285+ = App ss comp []
286+ where
287+ fnUnsafePartial :: forall a b. (IsString a, IsString b) => (a, b)
288+ fnUnsafePartial = (C.partialUnsafe, C.unsafePartial)
289+ convert other = other
290+
291+semiringNumber :: forall a b. (IsString a, IsString b) => (a, b)
292+semiringNumber = (C.dataSemiring, C.semiringNumber)
293+
294+semiringInt :: forall a b. (IsString a, IsString b) => (a, b)
295+semiringInt = (C.dataSemiring, C.semiringInt)
296+
297+ringNumber :: forall a b. (IsString a, IsString b) => (a, b)
298+ringNumber = (C.dataRing, C.ringNumber)
299+
300+ringInt :: forall a b. (IsString a, IsString b) => (a, b)
301+ringInt = (C.dataRing, C.ringInt)
302+
303+euclideanRingNumber :: forall a b. (IsString a, IsString b) => (a, b)
304+euclideanRingNumber = (C.dataEuclideanRing, C.euclideanRingNumber)
305+
306+-- eqNumber :: forall a b. (IsString a, IsString b) => (a, b)
307+-- eqNumber = (C.dataEq, C.eqNumber)
308+
309+eqInt :: forall a b. (IsString a, IsString b) => (a, b)
310+eqInt = (C.dataEq, C.eqInt)
311+
312+eqString :: forall a b. (IsString a, IsString b) => (a, b)
313+eqString = (C.dataEq, C.eqString)
314+
315+eqChar :: forall a b. (IsString a, IsString b) => (a, b)
316+eqChar = (C.dataEq, C.eqChar)
317+
318+eqBoolean :: forall a b. (IsString a, IsString b) => (a, b)
319+eqBoolean = (C.dataEq, C.eqBoolean)
320+
321+ordBoolean :: forall a b. (IsString a, IsString b) => (a, b)
322+ordBoolean = (C.dataOrd, C.ordBoolean)
323+
324+ordNumber :: forall a b. (IsString a, IsString b) => (a, b)
325+ordNumber = (C.dataOrd, C.ordNumber)
326+
327+ordInt :: forall a b. (IsString a, IsString b) => (a, b)
328+ordInt = (C.dataOrd, C.ordInt)
329+
330+ordString :: forall a b. (IsString a, IsString b) => (a, b)
331+ordString = (C.dataOrd, C.ordString)
332+
333+ordChar :: forall a b. (IsString a, IsString b) => (a, b)
334+ordChar = (C.dataOrd, C.ordChar)
335+
336+semigroupString :: forall a b. (IsString a, IsString b) => (a, b)
337+semigroupString = (C.dataSemigroup, C.semigroupString)
338+
339+boundedBoolean :: forall a b. (IsString a, IsString b) => (a, b)
340+boundedBoolean = (C.dataBounded, C.boundedBoolean)
341+
342+heytingAlgebraBoolean :: forall a b. (IsString a, IsString b) => (a, b)
343+heytingAlgebraBoolean = (C.dataHeytingAlgebra, C.heytingAlgebraBoolean)
344+
345+semigroupoidFn :: forall a b. (IsString a, IsString b) => (a, b)
346+semigroupoidFn = (C.controlSemigroupoid, C.semigroupoidFn)
347+
348+opAdd :: forall a b. (IsString a, IsString b) => (a, b)
349+opAdd = (C.dataSemiring, C.add)
350+
351+opMul :: forall a b. (IsString a, IsString b) => (a, b)
352+opMul = (C.dataSemiring, C.mul)
353+
354+opEq :: forall a b. (IsString a, IsString b) => (a, b)
355+opEq = (C.dataEq, C.eq)
356+
357+opNotEq :: forall a b. (IsString a, IsString b) => (a, b)
358+opNotEq = (C.dataEq, C.notEq)
359+
360+opLessThan :: forall a b. (IsString a, IsString b) => (a, b)
361+opLessThan = (C.dataOrd, C.lessThan)
362+
363+opLessThanOrEq :: forall a b. (IsString a, IsString b) => (a, b)
364+opLessThanOrEq = (C.dataOrd, C.lessThanOrEq)
365+
366+opGreaterThan :: forall a b. (IsString a, IsString b) => (a, b)
367+opGreaterThan = (C.dataOrd, C.greaterThan)
368+
369+opGreaterThanOrEq :: forall a b. (IsString a, IsString b) => (a, b)
370+opGreaterThanOrEq = (C.dataOrd, C.greaterThanOrEq)
371+
372+opAppend :: forall a b. (IsString a, IsString b) => (a, b)
373+opAppend = (C.dataSemigroup, C.append)
374+
375+opSub :: forall a b. (IsString a, IsString b) => (a, b)
376+opSub = (C.dataRing, C.sub)
377+
378+opNegate :: forall a b. (IsString a, IsString b) => (a, b)
379+opNegate = (C.dataRing, C.negate)
380+
381+opDiv :: forall a b. (IsString a, IsString b) => (a, b)
382+opDiv = (C.dataEuclideanRing, C.div)
383+
384+opConj :: forall a b. (IsString a, IsString b) => (a, b)
385+opConj = (C.dataHeytingAlgebra, C.conj)
386+
387+opDisj :: forall a b. (IsString a, IsString b) => (a, b)
388+opDisj = (C.dataHeytingAlgebra, C.disj)
389+
390+opNot :: forall a b. (IsString a, IsString b) => (a, b)
391+opNot = (C.dataHeytingAlgebra, C.not)
392+
393+unbox :: AST -> PSString -> AST
394+unbox e d = select . inlineCommonValues $ inlineCommonOperators e
395+ where
396+ select :: AST -> AST
397+ select e' =
398+ case e' of
399+ Var{} -> unbox' e'
400+ App{} -> unbox' e'
401+ Indexer{} -> unbox' e'
402+ _ -> e'
403+ unbox' :: AST -> AST
404+ unbox' e' = maybe e' (\t -> App Nothing (StringLiteral Nothing t) [e']) $ unboxType d
405+
406+unboxType :: PSString -> Maybe PSString
407+unboxType s = do
408+ t <- decodeString s
409+ t' <- unboxType' t
410+ return $ mkString t'
411+ where
412+ unboxType' :: Text -> Maybe Text
413+ unboxType' t
414+ | t == C.eqInt ||
415+ t == C.semiringInt ||
416+ t == C.ringInt ||
417+ t == C.ordInt ||
418+ t == C.dataIntBits
419+ = Just int
420+ | t == C.semiringNumber ||
421+ t == C.ringNumber ||
422+ t == C.ordNumber ||
423+ t == C.euclideanRingNumber
424+ = Just float
425+ | t == C.eqBoolean ||
426+ t == C.ordBoolean ||
427+ t == C.heytingAlgebraBoolean
428+ = Just bool
429+ | t == C.eqChar ||
430+ t == C.eqString ||
431+ t == C.ordChar ||
432+ t == C.ordString ||
433+ t == C.semigroupString
434+ = Just string
435+ | otherwise = Nothing
src/CodeGen/IL/Optimizer/MagicDo.hsnew file+146
@@ -0,0 +1,146 @@
1+-- | This module implements the "Magic Do" optimization, which inlines calls to return
2+-- and bind for the Eff monad, as well as some of its actions.
3+module CodeGen.IL.Optimizer.MagicDo (magicDoEffect, magicDoEff, magicDoST, inlineST) where
4+
5+import Prelude.Compat
6+import Protolude (ordNub)
7+
8+import Data.Maybe (fromJust, isJust)
9+import Data.Text (Text)
10+
11+import Language.PureScript.CoreImp.AST
12+import Language.PureScript.CoreImp.Optimizer.Common hiding (isDict)
13+import Language.PureScript.PSString (PSString, decodeString, mkString)
14+import qualified Language.PureScript.Constants as C
15+
16+import CodeGen.IL.Common (undefinedName, unusedName)
17+import CodeGen.IL.Optimizer.Common
18+
19+-- | Inline type class dictionaries for >>= and return for the Eff monad
20+--
21+-- E.g.
22+--
23+-- Prelude[">>="](dict)(m1)(function(x) {
24+-- return ...;
25+-- })
26+--
27+-- becomes
28+--
29+-- function __do {
30+-- var x = m1();
31+-- ...
32+-- }
33+magicDoEff :: AST -> AST
34+magicDoEff = magicDo C.eff C.effDictionaries
35+
36+magicDoEffect :: AST -> AST
37+magicDoEffect = magicDo C.effect C.effectDictionaries
38+
39+magicDoST :: AST -> AST
40+magicDoST = magicDo C.st C.stDictionaries
41+
42+magicDo :: Text -> C.EffectDictionaries -> AST -> AST
43+magicDo effectModule C.EffectDictionaries{..} = everywhereTopDown convert
44+ where
45+ -- Desugar monomorphic calls to >>= and return for the Eff monad
46+ convert :: AST -> AST
47+ -- Desugar pure
48+ convert (App _ (App _ pure' [val]) []) | isPure pure' = val
49+ -- Desugar discard
50+ convert (App _ (App _ bind [m]) [Function s1 Nothing [unused] (Block s2 il)]) | isDiscard bind && unused == unusedName =
51+ Function s1 Nothing [] $ Block s2 (App s2 m [] : map applyReturns il )
52+ -- Desugar bind
53+ convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 il)]) | isBind bind =
54+ Function s1 Nothing [] $ Block s2 (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns il)
55+ -- Desugar untilE
56+ convert (App s1 (App _ f [arg]) []) | isEffFunc edUntil f =
57+ App s1 (Function s1 Nothing [] (Block s1 [ While s1 (Unary s1 Not (App s1 arg [])) (Block s1 []), Return s1 $ ObjectLiteral s1 []])) []
58+ -- Desugar whileE
59+ convert (App _ (App _ (App s1 f [arg1]) [arg2]) []) | isEffFunc edWhile f =
60+ App s1 (Function s1 Nothing [] (Block s1 [ While s1 (App s1 arg1 []) (Block s1 [ App s1 arg2 [] ]), Return s1 $ ObjectLiteral s1 []])) []
61+ -- -- Inline __do returns
62+ -- convert (Return _ (App _ (Function _ (Just ident) [] body) [])) | ident == fnName = body
63+ -- Inline double applications
64+ convert (App _ (App s1 (Function s2 Nothing [] (Block ss body)) []) []) =
65+ App s1 (Function s2 Nothing [] (Block ss (applyReturns `fmap` body))) []
66+ convert other = other
67+ -- Check if an expression represents a monomorphic call to >>= for the Eff monad
68+ isBind (App _ fn [dict]) | isDict (effectModule, edBindDict) dict && isBindPoly fn = True
69+ isBind _ = False
70+ -- Check if an expression represents a call to @discard@
71+ isDiscard (App _ (App _ fn [dict1]) [dict2])
72+ | isDict (C.controlBind, C.discardUnitDictionary) dict1 &&
73+ isDict (effectModule, edBindDict) dict2 &&
74+ isDiscardPoly fn = True
75+ isDiscard _ = False
76+
77+ -- Check if an expression represents a monomorphic call to pure or return for the Eff applicative
78+ isPure (App _ fn [dict]) | isDict (effectModule, edApplicativeDict) dict && isPurePoly fn = True
79+ isPure _ = False
80+ -- Check if an expression represents the polymorphic >>= function
81+ isBindPoly = isDict (C.controlBind, C.bind)
82+ -- Check if an expression represents the polymorphic pure function
83+ isPurePoly = isDict (C.controlApplicative, C.pure')
84+ -- Check if an expression represents the polymorphic discard function
85+ isDiscardPoly = isDict (C.controlBind, C.discard)
86+ -- Check if an expression represents a function in the Effect module
87+ isEffFunc name (Indexer _ (StringLiteral _ name') (Var _ eff)) = eff == effectModule && name == name'
88+ isEffFunc _ _ = False
89+
90+ applyReturns :: AST -> AST
91+ applyReturns (Return ss ret) = Return ss (App ss ret [])
92+ applyReturns (Block ss ils) = Block ss (map applyReturns ils)
93+ applyReturns (While ss cond il) = While ss cond (applyReturns il)
94+ applyReturns (For ss v lo hi il) = For ss v lo hi (applyReturns il)
95+ applyReturns (ForIn ss v xs il) = ForIn ss v xs (applyReturns il)
96+ applyReturns (IfElse ss cond t f) = IfElse ss cond (applyReturns t) (applyReturns `fmap` f)
97+ applyReturns other = other
98+
99+-- | Inline functions in the ST module
100+inlineST :: AST -> AST
101+inlineST = everywhere convertBlock
102+ where
103+ -- Look for runST blocks and inline the STRefs there.
104+ -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
105+ -- we can be more aggressive about inlining, and actually turn STRefs into local variables.
106+ convertBlock (App s1 f [arg]) | isSTFunc C.runST f =
107+ let refs = ordNub . findSTRefsIn $ arg
108+ usages = findAllSTUsagesIn arg
109+ allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
110+ localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs
111+ in App s1 (everywhere (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg) []
112+ convertBlock other = other
113+ -- Convert a block in a safe way, preserving object wrappers of references,
114+ -- or in a more aggressive way, turning wrappers into local variables depending on the
115+ -- agg(ressive) parameter.
116+ convert agg (App s1 f [arg]) | isSTFunc C.newSTRef f =
117+ Function s1 Nothing [] (Block s1 [Return s1 $ if agg then arg else ObjectLiteral s1 [(mkString C.stRefValue, arg)]])
118+ convert agg (App _ (App s1 f [ref]) []) | isSTFunc C.readSTRef f =
119+ if agg then ref else Indexer s1 (StringLiteral s1 C.stRefValue) ref
120+ convert agg (App _ (App _ (App s1 f [arg]) [ref]) []) | isSTFunc C.writeSTRef f =
121+ if agg then Assignment s1 ref arg else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) arg
122+ convert agg (App _ (App _ (App s1 f [func]) [ref]) []) | isSTFunc C.modifySTRef f =
123+ if agg then Assignment s1 ref (App s1 func [ref]) else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) (App s1 func [Indexer s1 (StringLiteral s1 C.stRefValue) ref])
124+ convert _ other = other
125+ -- Check if an expression represents a function in the ST module
126+ isSTFunc name (Indexer _ (StringLiteral _ name') (Var _ st)) = st == C.st && name == name'
127+ isSTFunc _ _ = False
128+ -- Find all ST Refs initialized in this block
129+ findSTRefsIn = everything (++) isSTRef
130+ where
131+ isSTRef (VariableIntroduction _ ident (Just (App _ (App _ f [_]) []))) | isSTFunc C.newSTRef f = [ident]
132+ isSTRef _ = []
133+ -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef
134+ findAllSTUsagesIn = everything (++) isSTUsage
135+ where
136+ isSTUsage (App _ (App _ f [ref]) []) | isSTFunc C.readSTRef f = [ref]
137+ isSTUsage (App _ (App _ (App _ f [_]) [ref]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]
138+ isSTUsage _ = []
139+ -- Find all uses of a variable
140+ appearingIn ref = everything (++) isVar
141+ where
142+ isVar e@(Var _ v) | v == ref = [e]
143+ isVar _ = []
144+ -- Convert a AST value to a String if it is a Var
145+ toVar (Var _ v) = Just v
146+ toVar _ = Nothing
src/CodeGen/IL/Optimizer/TCO.hsnew file+141
@@ -0,0 +1,141 @@
1+module CodeGen.IL.Optimizer.TCO (tco, tcoLoop) where
2+
3+import Prelude.Compat
4+
5+import Data.Text (Text)
6+import Data.Monoid ((<>))
7+import Language.PureScript.CoreImp.AST
8+import Language.PureScript.AST.SourcePos (SourceSpan)
9+import Safe (headDef, tailSafe)
10+import CodeGen.IL.Common
11+
12+import qualified Language.PureScript.Constants as C
13+
14+tcoLoop :: Text
15+tcoLoop = "ṩtco_loop"
16+
17+tco :: AST -> AST -> AST
18+tco mn = everywhere convert where
19+ tcoVar :: Text -> Text
20+ tcoVar arg = "ṩtco_var_" <> arg
21+
22+ copyVar :: Text -> Text
23+ copyVar arg = "ṩcopy_" <> arg
24+
25+ tcoDone :: Text
26+ tcoDone = "ṩtco_done"
27+
28+ tcoResult :: Text
29+ tcoResult = "ṩtco_result"
30+
31+ convert :: AST -> AST
32+ convert fn@(Function ss (Just name) args _)
33+ | isTailRecursive name body'
34+ = replace (toLoop name outerArgs innerArgs body')
35+ where
36+ innerArgs = headDef [] argss
37+ outerArgs = concat . reverse $ tailSafe argss
38+ (argss, body', replace) = collectAllFunctionArgs [] id fn
39+ convert (Assignment ss (Var _ name) fn@(Function _ Nothing _ _))
40+ | isTailRecursive name body'
41+ = Assignment ss (Var ss name) (replace (toLoop name outerArgs innerArgs body'))
42+ where
43+ innerArgs = headDef [] argss
44+ outerArgs = concat . reverse $ tailSafe argss
45+ (argss, body', replace) = collectAllFunctionArgs [] id fn
46+ convert js = js
47+
48+ collectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
49+ collectAllFunctionArgs allArgs f (Function s1 ident args (Block s2 (body@(Return _ _):_))) =
50+ collectAllFunctionArgs (args : allArgs) (\b -> f (Function s1 ident (map copyVar args) (Block s2 [b]))) body
51+ collectAllFunctionArgs allArgs f (Function ss ident args body@(Block _ _)) =
52+ (args : allArgs, body, f . Function ss ident (map copyVar args))
53+ collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args (Block s3 [body]))) =
54+ collectAllFunctionArgs (args : allArgs) (\b -> f (Return s1 (Function s2 ident (map copyVar args) (Block s3 [b])))) body
55+ collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args body@(Block _ _))) =
56+ (args : allArgs, body, f . Return s1 . Function s2 ident (map copyVar args))
57+ collectAllFunctionArgs allArgs f body = (allArgs, body, f)
58+
59+ isTailRecursive :: Text -> AST -> Bool
60+ isTailRecursive ident js = countSelfReferences js > 0 && allInTailPosition js where
61+ countSelfReferences = everything (+) match where
62+ match :: AST -> Int
63+ match (Var _ ident') | ident == ident' = 1
64+ match _ = 0
65+
66+ allInTailPosition (Return _ expr)
67+ | isSelfCall ident expr = countSelfReferences expr == 1
68+ | otherwise = countSelfReferences expr == 0
69+ allInTailPosition (While _ js1 body)
70+ = countSelfReferences js1 == 0 && allInTailPosition body
71+ allInTailPosition (For _ _ js1 js2 body)
72+ = countSelfReferences js1 == 0 && countSelfReferences js2 == 0 && allInTailPosition body
73+ allInTailPosition (ForIn _ _ js1 body)
74+ = countSelfReferences js1 == 0 && allInTailPosition body
75+ allInTailPosition (IfElse _ js1 body el)
76+ = countSelfReferences js1 == 0 && allInTailPosition body && all allInTailPosition el
77+ allInTailPosition (Block _ body)
78+ = all allInTailPosition body
79+ allInTailPosition (Throw _ js1)
80+ = countSelfReferences js1 == 0
81+ allInTailPosition (ReturnNoResult _)
82+ = True
83+ allInTailPosition (VariableIntroduction _ _ js1)
84+ = all ((== 0) . countSelfReferences) js1
85+ allInTailPosition (Assignment _ _ js1)
86+ = countSelfReferences js1 == 0
87+ allInTailPosition (Comment _ _ js1)
88+ = allInTailPosition js1
89+ allInTailPosition _
90+ = False
91+
92+ toLoop :: Text -> [Text] -> [Text] -> AST -> AST
93+ toLoop ident outerArgs innerArgs js =
94+ Block rootSS $
95+ concatMap (\arg -> [ VariableIntroduction rootSS (tcoVar arg) . Just $
96+ Var rootSS (copyVar arg) ]) (outerArgs ++ innerArgs) ++
97+ [ Assignment rootSS (Var rootSS $ "var " <> tcoDone) $ BooleanLiteral Nothing False
98+ , VariableIntroduction rootSS tcoResult Nothing
99+ , Assignment rootSS (Var rootSS $ "var " <> tcoLoop) (Function rootSS (Just tcoLoop) (outerArgs ++ innerArgs) (Block rootSS [loopify js]))
100+ , While rootSS (Unary Nothing Not (Var rootSS tcoDone))
101+ (Block rootSS
102+ [(Assignment rootSS (Var rootSS tcoResult) (App rootSS (Var rootSS tcoLoop) ((map (Var rootSS . tcoVar) outerArgs) ++ (map (Var rootSS . copyVar) innerArgs))))])
103+ , Return rootSS (Var rootSS tcoResult)
104+ ]
105+ where
106+ rootSS = Nothing
107+
108+ loopify :: AST -> AST
109+ loopify (Return ss ret)
110+ | isSelfCall ident ret =
111+ let
112+ allArgumentValues = concat $ collectArgs [] ret
113+ in
114+ Block ss $
115+ zipWith (\val arg ->
116+ Assignment ss (Var ss (tcoVar arg)) val) allArgumentValues outerArgs
117+ ++ zipWith (\val arg ->
118+ Assignment ss (Var ss (copyVar arg)) val) (drop (length outerArgs) allArgumentValues) innerArgs
119+ ++ [ ReturnNoResult ss ]
120+ | otherwise = Block ss [ markDone ss, Return ss ret ]
121+ loopify (ReturnNoResult ss) = Block ss [ markDone ss, ReturnNoResult ss ]
122+ loopify (While ss cond body) = While ss cond (loopify body)
123+ loopify (For ss i js1 js2 body) = For ss i js1 js2 (loopify body)
124+ loopify (ForIn ss i js1 body) = ForIn ss i js1 (loopify body)
125+ loopify (IfElse ss cond body el) = IfElse ss cond (loopify body) (fmap loopify el)
126+ loopify (Block ss body) = Block ss (map loopify body)
127+ loopify other = other
128+
129+ markDone :: Maybe SourceSpan -> AST
130+ markDone ss = Assignment ss (Var ss tcoDone) (BooleanLiteral ss True)
131+
132+ collectArgs :: [[AST]] -> AST -> [[AST]]
133+ collectArgs acc (App _ fn args') = collectArgs (args' : acc) fn
134+ collectArgs acc _ = acc
135+
136+ isSelfCall :: Text -> AST -> Bool
137+ isSelfCall ident (App _ (Var _ ident') _) = ident == ident'
138+ isSelfCall ident (App _ (Indexer _ (Var _ ident') (Var _ mn')) _) = mn' == "" && ident == ident'
139+ isSelfCall ident (App _ (Indexer _ (Var _ ident') mn') _) = mn' == mn && ident == ident'
140+ isSelfCall ident (App _ fn _) = isSelfCall ident fn
141+ isSelfCall _ _ = False
src/CodeGen/IL/Printer.hsnew file+527
@@ -0,0 +1,527 @@
1+-- | Pretty printer for the AST
2+module CodeGen.IL.Printer
3+ ( prettyPrintIL
4+ , prettyPrintIL1
5+ , prettyPrintILWithSourceMaps
6+ , interfaceSource
7+ , implHeaderSource
8+ , implFooterSource
9+ , isLiteral
10+ , modLabel
11+ , modPrefix
12+ , ffiLoader
13+ ) where
14+
15+import Prelude.Compat
16+
17+import Control.Arrow ((<+>))
18+import Control.Monad (forM, mzero)
19+import Control.Monad.State (StateT, evalStateT)
20+import Control.PatternArrows
21+import Data.List (filter, (\\))
22+import qualified Control.Arrow as A
23+
24+import Data.Maybe (fromMaybe)
25+import Data.Monoid ((<>))
26+import Data.Text (Text)
27+import qualified Data.Text as T
28+
29+import Language.PureScript.AST (SourceSpan(..))
30+import Language.PureScript.CoreImp.AST
31+import Language.PureScript.Comments
32+import Language.PureScript.Crash
33+import Language.PureScript.Names (Ident, runIdent)
34+import Language.PureScript.Pretty.Common
35+import Language.PureScript.PSString (PSString, decodeString, mkString)
36+
37+import CodeGen.IL.Common
38+import CodeGen.IL.Optimizer.TCO (tcoLoop)
39+
40+import qualified Language.PureScript.Constants as C
41+
42+-- TODO (Christoph): Get rid of T.unpack / pack
43+
44+literals :: (Emit gen) => Pattern PrinterState AST gen
45+literals = mkPattern' match'
46+ where
47+ match' :: (Emit gen) => AST -> StateT PrinterState Maybe gen
48+ match' il = (addMapping' (getSourceSpan il) <>) <$> match il
49+
50+ match :: (Emit gen) => AST -> StateT PrinterState Maybe gen
51+ match (NumericLiteral _ n) = return $ emit $ T.pack $ either show show n
52+ match (StringLiteral _ s) = return $ emit $ stringLiteral s
53+ match (BooleanLiteral _ True) = return $ emit "true"
54+ match (BooleanLiteral _ False) = return $ emit "false"
55+ match (ArrayLiteral _ xs) = mconcat <$> sequence
56+ [ return . emit $ arrayType <> "{"
57+ , intercalate (emit ", ") <$> forM xs prettyPrintIL'
58+ , return $ emit "}"
59+ ]
60+ -- match (ObjectLiteral _ []) = return $ emit "std::initializer_list<std::pair<const string, boxed>>{}"
61+ match (ObjectLiteral _ ps) = mconcat <$> sequence
62+ [ return . emit $ dictType <> "{"
63+ , withIndent $ do
64+ ils <- forM ps $ \(key, value) -> do
65+ value' <- prettyPrintIL' value
66+ return $ objectPropertyToString key <> value'
67+ return $ intercalate (emit " ") $ map (<> emit ",") ils
68+ , return $ emit "}"
69+ ]
70+ where
71+ objectPropertyToString :: (Emit gen) => PSString -> gen
72+ objectPropertyToString s = emit $ stringLiteral s <> ": "
73+ match (Block _ sts) = mconcat <$> sequence
74+ [ return $ emit "{\n"
75+ , withIndent $ prettyStatements sts
76+ , return $ emit "\n"
77+ , currentIndent
78+ , return $ emit "}"
79+ ]
80+ match (Var _ ident) | ident == C.undefined = return $ emit undefinedName
81+ match (Var _ ident) = return $ emit ident
82+ match (VariableIntroduction _ ident value) = mconcat <$> sequence
83+ [ return . emit $ varDecl <> " " <> ident <> " " <> anyType
84+ , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintIL') value
85+ ]
86+ match (Assignment _ target value) = mconcat <$> sequence
87+ [ prettyPrintIL' target
88+ , return $ emit " = "
89+ , prettyPrintIL' value
90+ ]
91+ match (App _ val []) = mconcat <$> sequence
92+ [ return $ emit "Run("
93+ , prettyPrintIL' val
94+ , return $ emit ")"
95+ ]
96+ match (App _ (StringLiteral _ u) [arg])
97+ | Just ty <- decodeString u = mconcat <$> sequence
98+ [ prettyPrintIL' arg
99+ , return $ emit ".("
100+ , return $ emit ty
101+ , return $ emit ")"
102+ ]
103+ match (App _ (Var _ fn) [arg]) | fn == arrayLengthFn = mconcat <$> sequence
104+ [ return $ emit fn
105+ , return $ emit "("
106+ , prettyPrintIL' arg
107+ , return $ emit ")"
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+ ]
115+ match (App _ (Var _ fn) args) | fn == tcoLoop = mconcat <$> sequence
116+ [ return $ emit fn
117+ , return $ emit "("
118+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
119+ , return $ emit ")"
120+ ]
121+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn@Function{}]) args)
122+ | Just ftype <- decodeString fnx
123+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
124+ [ prettyPrintIL' fn
125+ , return $ emit "("
126+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
127+ , return $ emit ")"
128+ ]
129+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn]) args)
130+ | Just ftype <- decodeString fnx
131+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
132+ [ prettyPrintIL' fn
133+ , return $ emit ".("
134+ , return $ emit ftype
135+ , return $ emit ")("
136+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
137+ , return $ emit ")"
138+ ]
139+ match app@(App{})
140+ | (val, args) <- unApp app []
141+ , length args > 1
142+ = mconcat <$> sequence
143+ [ return $ emit "Apply("
144+ , prettyPrintIL' val
145+ , return $ emit ", "
146+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
147+ , return $ emit ")"
148+ ]
149+ match (App _ val args) = mconcat <$> sequence
150+ [ return $ emit "Apply("
151+ , prettyPrintIL' val
152+ , return $ emit ", "
153+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
154+ , return $ emit ")"
155+ ]
156+ match (Function _ (Just name) [] (Block _ [Return _ ret]))
157+ | isComplexLiteral ret = mconcat <$> sequence
158+ [ return $ emit "\n"
159+ , return . emit $ varDecl <> " " <> initName name <> " Once\n"
160+ , prettyPrintIL' $ VariableIntroduction Nothing (valueName name) Nothing
161+ , return $ emit "\n\n"
162+ , return $ emit "func "
163+ , return . emit $ withPrefix name
164+ , return . emit $ "() " <> anyType <> " "
165+ , return $ emit "{\n"
166+ , withIndent $ do
167+ indentString <- currentIndent
168+ return $ indentString <> (emit $ initName name <> ".Do(func() {\n") <>
169+ indentString <> indentString <> (emit $ valueName name <> " = ")
170+ , withIndent $ do
171+ case ret of
172+ Function _ Nothing args body -> mconcat <$> sequence
173+ [ return $ emit "func("
174+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
175+ , return . emit $ ") " <> anyType <> " "
176+ , prettyPrintIL' body
177+ ]
178+ _ -> do
179+ prettyPrintIL' ret
180+ , return $ emit "\n"
181+ , withIndent $ do
182+ indentString <- currentIndent
183+ return $ indentString <> (emit $ "})\n" <> "return " <> valueName name <>"\n")
184+ , return $ emit "}\n\n"
185+ ]
186+ match (Function _ (Just name) [] ret) = mconcat <$> sequence
187+ [ return $ emit "func "
188+ , return . emit $ withPrefix name
189+ , return . emit $ "() " <> anyType <> " "
190+ , prettyPrintIL' ret
191+ ]
192+ match (Function _ _ args ret) = mconcat <$> sequence
193+ [ return $ emit "func("
194+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
195+ , return . emit $ ") " <> anyType <> " "
196+ , prettyPrintIL' ret
197+ ]
198+ match (Indexer _ (Var _ name) (Var _ "")) = mconcat <$> sequence
199+ [ prettyPrintIL' (Var Nothing $ withPrefix name)
200+ , return $ emit "()"
201+ ]
202+ match (Indexer _ (Var _ name) val) = mconcat <$> sequence
203+ [ prettyPrintIL' val
204+ , return $ emit "."
205+ , prettyPrintIL' (Var Nothing $ withPrefix name)
206+ , return $ emit "()"
207+ ]
208+ match (Indexer _ prop@StringLiteral{} val@ObjectLiteral{}) = mconcat <$> sequence
209+ [ prettyPrintIL' val
210+ , return $ emit "["
211+ , prettyPrintIL' prop
212+ , return $ emit "]"
213+ ]
214+ match (Indexer _ prop@StringLiteral{} val) = mconcat <$> sequence
215+ [ prettyPrintIL' val
216+ , return $ emit ".("
217+ , return $ emit dictType
218+ , return $ emit ")["
219+ , prettyPrintIL' prop
220+ , return $ emit "]"
221+ ]
222+ match (Indexer _ index val@ArrayLiteral{}) = mconcat <$> sequence
223+ [ prettyPrintIL' val
224+ , return $ emit "["
225+ , prettyPrintIL' index
226+ , return $ emit "]"
227+ ]
228+ match (Indexer _ index val) = mconcat <$> sequence
229+ [ prettyPrintIL' val
230+ , return $ emit ".("
231+ , return $ emit arrayType
232+ , return $ emit ")["
233+ , prettyPrintIL' index
234+ , return $ emit "]"
235+ ]
236+ match (InstanceOf _ val ty) = mconcat <$> sequence
237+ [ return $ emit "Is("
238+ , prettyPrintIL' val
239+ , return $ emit ", "
240+ , prettyPrintIL' ty
241+ , return $ emit ")"
242+ ]
243+ match (While _ cond sts) = mconcat <$> sequence
244+ [ return $ emit "for "
245+ , prettyPrintIL' cond
246+ , return $ emit " "
247+ , prettyPrintIL' sts
248+ ]
249+ match (For _ ident start end sts) = mconcat <$> sequence
250+ [ return $ emit $ "for var " <> ident <> " = "
251+ , prettyPrintIL' start
252+ , return $ emit $ "; " <> ident <> " < "
253+ , prettyPrintIL' end
254+ , return $ emit $ "; " <> ident <> "++ "
255+ , prettyPrintIL' sts
256+ ]
257+ match (ForIn _ ident obj sts) = mconcat <$> sequence
258+ [ return $ emit $ "for var " <> ident <> " in "
259+ , prettyPrintIL' obj
260+ , return $ emit " "
261+ , prettyPrintIL' sts
262+ ]
263+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (BooleanLiteral Nothing True)) thens elses) = mconcat <$> sequence
264+ [ return $ emit "if "
265+ , prettyPrintIL' cond
266+ , return $ emit " "
267+ , prettyPrintIL' thens
268+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
269+ ]
270+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (BooleanLiteral Nothing False)) thens elses) = mconcat <$> sequence
271+ [ return $ emit "if !("
272+ , prettyPrintIL' cond
273+ , return $ emit ") "
274+ , prettyPrintIL' thens
275+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
276+ ]
277+ match (IfElse _ cond thens elses) = mconcat <$> sequence
278+ [ return $ emit "if "
279+ , prettyPrintIL' cond
280+ , return $ emit " "
281+ , prettyPrintIL' thens
282+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
283+ ]
284+ match (Return _ value) = mconcat <$> sequence
285+ [ return $ emit "return "
286+ , prettyPrintIL' value
287+ ]
288+ match (ReturnNoResult _) = return . emit $ "return " <> undefinedName
289+ -- match (Throw _ _) = return mempty
290+ match (Throw _ value) = mconcat <$> sequence
291+ [ return $ emit "panic("
292+ , prettyPrintIL' value
293+ , return $ emit ")"
294+ ]
295+ match (Comment _ com il) = mconcat <$> sequence
296+ [ return $ emit "\n"
297+ , mconcat <$> forM com comment
298+ , prettyPrintIL' il
299+ ]
300+ match _ = mzero
301+
302+ comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen
303+ comment (LineComment com) = fmap mconcat $ sequence $
304+ [ currentIndent
305+ , return $ emit "//" <> emit com <> emit "\n"
306+ ]
307+ comment (BlockComment com) = fmap mconcat $ sequence $
308+ [ currentIndent
309+ , return $ emit "/**\n"
310+ ] ++
311+ map asLine (T.lines com) ++
312+ [ currentIndent
313+ , return $ emit " */\n"
314+ , currentIndent
315+ ]
316+ where
317+ asLine :: (Emit gen) => Text -> StateT PrinterState Maybe gen
318+ asLine s = do
319+ i <- currentIndent
320+ return $ i <> emit " * " <> (emit . removeComments) s <> emit "\n"
321+
322+ removeComments :: Text -> Text
323+ removeComments t =
324+ case T.stripPrefix "*/" t of
325+ Just rest -> removeComments rest
326+ Nothing -> case T.uncons t of
327+ Just (x, xs) -> x `T.cons` removeComments xs
328+ Nothing -> ""
329+
330+unary' :: (Emit gen) => UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
331+unary' op mkStr = Wrap match (<>)
332+ where
333+ match :: (Emit gen) => Pattern PrinterState AST (gen, AST)
334+ match = mkPattern match'
335+ where
336+ match' (Unary _ op' val) | op' == op = Just (emit $ mkStr val, val)
337+ match' _ = Nothing
338+
339+unary :: (Emit gen) => UnaryOperator -> Text -> Operator PrinterState AST gen
340+unary op str = unary' op (const str)
341+
342+negateOperator :: (Emit gen) => Operator PrinterState AST gen
343+negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")
344+ where
345+ isNegate (Unary _ Negate _) = True
346+ isNegate _ = False
347+
348+binary :: (Emit gen) => BinaryOperator -> Text -> Operator PrinterState AST gen
349+binary op str = AssocL match (\v1 v2 -> v1 <> emit (" " <> str <> " ") <> v2)
350+ where
351+ match :: Pattern PrinterState AST (AST, AST)
352+ match = mkPattern match'
353+ where
354+ match' (Binary _ op' v1 v2) | op' == op = Just (v1, v2)
355+ match' _ = Nothing
356+
357+isLiteral :: AST -> Bool
358+isLiteral Function{} = True
359+isLiteral NumericLiteral{} = True
360+isLiteral StringLiteral{} = True
361+isLiteral BooleanLiteral{} = True
362+isLiteral ObjectLiteral{} = True
363+isLiteral ArrayLiteral{} = True
364+isLiteral _ = False
365+
366+isComplexLiteral :: AST -> Bool
367+-- isComplexLiteral Function{} = True
368+isComplexLiteral ObjectLiteral{} = True
369+isComplexLiteral ArrayLiteral{} = True
370+isComplexLiteral _ = False
371+
372+unApp :: AST -> [AST] -> (AST, [AST])
373+unApp (App _ val [arg]) args = unApp val (arg : args)
374+unApp other args = (other, args)
375+
376+prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen
377+prettyStatements sts = do
378+ ils <- forM sts prettyPrintIL'
379+ indentString <- currentIndent
380+ return $ intercalate (emit "\n") $ map (indentString <>) ils
381+
382+-- | Generate a pretty-printed string representing a collection of C++ expressions at the same indentation level
383+prettyPrintILWithSourceMaps :: [AST] -> (Text, [SMap])
384+prettyPrintILWithSourceMaps il =
385+ let StrPos (_, s, mp) = (fromMaybe (internalError "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements) il
386+ in (s, mp)
387+
388+prettyPrintIL :: [AST] -> Text
389+prettyPrintIL = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyStatements
390+
391+-- | Generate an indented, pretty-printed string representing a C++ expression
392+prettyPrintIL' :: (Emit gen) => AST -> StateT PrinterState Maybe gen
393+prettyPrintIL' = A.runKleisli $ runPattern matchValue
394+ where
395+ matchValue :: (Emit gen) => Pattern PrinterState AST gen
396+ matchValue = buildPrettyPrinter operators (literals <+> fmap parensPos matchValue)
397+ operators :: (Emit gen) => OperatorTable PrinterState AST gen
398+ operators =
399+ OperatorTable [ [ unary New "?" ]
400+ , [ unary Not "!"
401+ , unary BitwiseNot "~"
402+ , unary Positive "+"
403+ , negateOperator ]
404+ , [ binary Multiply "*"
405+ , binary Divide "/"
406+ , binary Modulus "%" ]
407+ , [ binary Add "+"
408+ , binary Subtract "-" ]
409+ , [ binary ShiftLeft "<<"
410+ , binary ShiftRight ">>" ]
411+ , [ binary LessThan "<"
412+ , binary LessThanOrEqualTo "<="
413+ , binary GreaterThan ">"
414+ , binary GreaterThanOrEqualTo ">=" ]
415+ , [ binary EqualTo "=="
416+ , binary NotEqualTo "!=" ]
417+ , [ binary BitwiseAnd "&" ]
418+ , [ binary BitwiseXor "^" ]
419+ , [ binary BitwiseOr "|" ]
420+ , [ binary And "&&" ]
421+ , [ binary Or "||" ]
422+ ]
423+
424+prettyPrintIL1 :: AST -> Text
425+prettyPrintIL1 = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyPrintIL'
426+
427+stringLiteral :: PSString -> Text
428+stringLiteral pss | Just s <- decodeString pss = stringLiteral' s
429+ where
430+ stringLiteral' :: Text -> Text
431+ stringLiteral' s = "\"" <> T.concatMap encodeChar s <> "\""
432+ encodeChar :: Char -> Text
433+ encodeChar '\0' = "\\x00"
434+ encodeChar '\b' = "\\b"
435+ encodeChar '\t' = "\\t"
436+ encodeChar '\n' = "\\n"
437+ encodeChar '\v' = "\\v"
438+ encodeChar '\f' = "\\f"
439+ encodeChar '\r' = "\\r"
440+ encodeChar '"' = "\\\""
441+ encodeChar '\\' = "\\\\"
442+ encodeChar c = T.singleton $ c
443+stringLiteral _ = "\"\\uFFFD\""
444+
445+interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
446+interfaceSource _ _ _ = ""
447+
448+implHeaderSource :: Text -> [Text] -> Text -> Text
449+implHeaderSource mn imports otherPrefix =
450+ "// Code generated by psgo. DO NOT EDIT.\n\n" <>
451+ "package " <> (if mn == "Main" || mn == "Test_Main" then "main" else mn) <> "\n\n" <>
452+ "import . \"" <> runtime <> "\"\n" <>
453+ (if mn == "Main" || mn == "Test_Main"
454+ then "import _ \"" <> otherPrefix <> "/" <> ffiLoader <> "\"\n"
455+ else "\n") <>
456+ "import (\n" <>
457+ (T.concat $ formatImport <$> imports) <> ")\n\n" <>
458+ "type _ = Any\n\n"
459+ where
460+ formatImport :: Text -> Text
461+ formatImport s =
462+ "\t\"" <> otherPrefix <> "/" <> modPrefix <> "/" <> moduleRenamer s <> "\"\n"
463+ moduleRenamer :: Text -> Text
464+ moduleRenamer s
465+ | (s', sfx) <- T.breakOn moduleRenamerMarker s,
466+ not $ T.null sfx = s'
467+ moduleRenamer s = s
468+
469+implFooterSource :: Text -> [Ident] -> Text
470+implFooterSource mn foreigns =
471+ "\n\n\n" <>
472+ (if null foreigns
473+ then ""
474+ else ("// Foreign values\n\n" <>
475+ "var " <> foreignDict <> " = "<> foreignMod <> "(\"" <> mn <> "\")\n\n" <>
476+ (T.concat $ (\foreign' ->
477+ let name = moduleIdentToIL foreign' in
478+ varDecl <> " " <> initName name <> " Once\n" <>
479+ varDecl <> " " <> valueName name <> " " <> anyType <> "\n\n" <>
480+ "func " <>
481+ withPrefix name <>
482+ "() Any { \n" <>
483+ " " <> initName name <> ".Do(func() {\n" <>
484+ " " <> valueName name <> " = " <>
485+ "Get(" <> foreignDict <> ", " <>
486+ (stringLiteral . mkString $ runIdent foreign') <> ")\n" <>
487+ " })\n" <>
488+ " return " <> valueName name <> "\n" <>
489+ "}\n\n") <$> foreigns))) <>
490+ if mn == "Main" || mn == "Test.Main" then mainSource else "\n"
491+ where
492+ mainSource :: Text
493+ mainSource = "\
494+ \func main() {\n\
495+ \ Run(Ꞌmain())\n\
496+ \}\n\n\
497+ \"
498+
499+varDecl :: Text
500+varDecl = "var"
501+
502+renderArg :: Text -> Text -> Text
503+renderArg decl arg = arg <> " " <> decl
504+
505+foreignMod :: Text
506+foreignMod = "Foreign"
507+
508+foreignDict :: Text
509+foreignDict = "foreign"
510+
511+modLabel :: Text
512+modLabel = "purescript-native"
513+
514+modPrefix :: Text
515+modPrefix = modLabel <> "/output"
516+
517+runtime :: Text
518+runtime = "github.com/" <> modLabel <> "/go-runtime"
519+
520+ffiLoader :: Text
521+ffiLoader = modLabel <> "/ffi-loader"
522+
523+initName :: Text -> Text
524+initName s = "ᛌ" <> s <> "_once"
525+
526+valueName :: Text -> Text
527+valueName s = "ᛧ" <> s
src/Control/Monad/Supply.hsdeleted−43
@@ -1,43 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Control.Monad.Supply
4−-- Copyright : (c) Phil Freeman 2014
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Fresh variable supply
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17−
18−module Control.Monad.Supply where
19−
20−import Data.Functor.Identity
21−
22−import Control.Applicative
23−import Control.Monad.State
24−import Control.Monad.Error.Class (MonadError(..))
25−import Control.Monad.Reader
26−import Control.Monad.Writer
27−
28−newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }
29− deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r)
30−
31−runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)
32−runSupplyT n = flip runStateT n . unSupplyT
33−
34−evalSupplyT :: (Functor m) => Integer -> SupplyT m a -> m a
35−evalSupplyT n = fmap fst . runSupplyT n
36−
37−type Supply = SupplyT Identity
38−
39−runSupply :: Integer -> Supply a -> (a, Integer)
40−runSupply n = runIdentity . runSupplyT n
41−
42−evalSupply :: Integer -> Supply a -> a
43−evalSupply n = runIdentity . evalSupplyT n
src/Control/Monad/Supply/Class.hsdeleted−36
@@ -1,36 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Control.Monad.Supply.Class
4−-- Copyright : (c) PureScript 2015
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- A class for monads supporting a supply of fresh names
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE MultiParamTypeClasses #-}
17−
18−module Control.Monad.Supply.Class where
19−
20−import Control.Monad.Supply
21−import Control.Monad.State
22−
23−class (Monad m) => MonadSupply m where
24− fresh :: m Integer
25−
26−instance (Monad m) => MonadSupply (SupplyT m) where
27− fresh = SupplyT $ do
28− n <- get
29− put (n + 1)
30− return n
31−
32−instance (MonadSupply m) => MonadSupply (StateT s m) where
33− fresh = lift fresh
34−
35−freshName :: (MonadSupply m) => m String
36−freshName = liftM (('_' :) . show) fresh
src/Control/Monad/Unify.hsdeleted−159
@@ -1,159 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Control.Monad.Unify
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17−{-# LANGUAGE FlexibleInstances #-}
18−{-# LANGUAGE FlexibleContexts #-}
19−{-# LANGUAGE DeriveDataTypeable #-}
20−{-# LANGUAGE MultiParamTypeClasses #-}
21−{-# LANGUAGE FunctionalDependencies #-}
22−{-# LANGUAGE UndecidableInstances #-}
23−
24−module Control.Monad.Unify where
25−
26−import Data.Monoid
27−
28−import Control.Applicative
29−import Control.Monad.State
30−import Control.Monad.Error.Class (MonadError(..))
31−
32−import Data.HashMap.Strict as M
33−
34−-- |
35−-- Untyped unification variables
36−--
37−type Unknown = Int
38−
39−-- |
40−-- A type which can contain unification variables
41−--
42−class Partial t where
43− unknown :: Unknown -> t
44− isUnknown :: t -> Maybe Unknown
45− unknowns :: t -> [Unknown]
46− ($?) :: Substitution t -> t -> t
47−
48−-- |
49−-- Identifies types which support unification
50−--
51−class (Partial t) => Unifiable m t | t -> m where
52− (=?=) :: t -> t -> UnifyT t m ()
53−
54−-- |
55−-- A substitution maintains a mapping from unification variables to their values
56−--
57−data Substitution t = Substitution { runSubstitution :: M.HashMap Int t }
58−
59−instance (Partial t) => Monoid (Substitution t) where
60− mempty = Substitution M.empty
61− s1 `mappend` s2 = Substitution $
62− M.map (s2 $?) (runSubstitution s1) `M.union`
63− M.map (s1 $?) (runSubstitution s2)
64−
65−-- |
66−-- State required for type checking
67−--
68−data UnifyState t = UnifyState {
69− -- |
70− -- The next fresh unification variable
71− --
72− unifyNextVar :: Int
73− -- |
74− -- The current substitution
75− --
76− , unifyCurrentSubstitution :: Substitution t
77− }
78−
79−-- |
80−-- An empty @UnifyState@
81−--
82−defaultUnifyState :: (Partial t) => UnifyState t
83−defaultUnifyState = UnifyState 0 mempty
84−
85−-- |
86−-- A class for errors which support unification errors
87−--
88−class UnificationError t e where
89− occursCheckFailed :: t -> e
90−
91−-- |
92−-- The type checking monad, which provides the state of the type checker, and error reporting capabilities
93−--
94−newtype UnifyT t m a = UnifyT { unUnify :: StateT (UnifyState t) m a }
95− deriving (Functor, Monad, Applicative, Alternative, MonadPlus)
96−
97−instance (MonadState s m) => MonadState s (UnifyT t m) where
98− get = UnifyT . lift $ get
99− put = UnifyT . lift . put
100−
101−instance (MonadError e m) => MonadError e (UnifyT t m) where
102− throwError = UnifyT . throwError
103− catchError e f = UnifyT $ catchError (unUnify e) (unUnify . f)
104−
105−-- |
106−-- Run a computation in the Unify monad, failing with an error, or succeeding with a return value and the new next unification variable
107−--
108−runUnify :: UnifyState t -> UnifyT t m a -> m (a, UnifyState t)
109−runUnify s = flip runStateT s . unUnify
110−
111−-- |
112−-- Substitute a single unification variable
113−--
114−substituteOne :: (Partial t) => Unknown -> t -> Substitution t
115−substituteOne u t = Substitution $ M.singleton u t
116−
117−-- |
118−-- Replace a unification variable with the specified value in the current substitution
119−--
120−(=:=) :: (UnificationError t e, Monad m, MonadError e m, Unifiable m t) => Unknown -> t -> UnifyT t m ()
121−(=:=) u t' = do
122− st <- UnifyT get
123− let sub = unifyCurrentSubstitution st
124− let t = sub $? t'
125− occursCheck u t
126− let current = sub $? unknown u
127− case isUnknown current of
128− Just u1 | u1 == u -> return ()
129− _ -> current =?= t
130− UnifyT $ modify $ \s -> s { unifyCurrentSubstitution = substituteOne u t <> unifyCurrentSubstitution s }
131−
132−-- |
133−-- Perform the occurs check, to make sure a unification variable does not occur inside a value
134−--
135−occursCheck :: (UnificationError t e, Monad m, MonadError e m, Partial t) => Unknown -> t -> UnifyT t m ()
136−occursCheck u t =
137− case isUnknown t of
138− Nothing -> when (u `elem` unknowns t) $ UnifyT . lift . throwError $ occursCheckFailed t
139− _ -> return ()
140−
141−-- |
142−-- Generate a fresh untyped unification variable
143−--
144−fresh' :: (Monad m) => UnifyT t m Unknown
145−fresh' = do
146− st <- UnifyT get
147− UnifyT $ modify $ \s -> s { unifyNextVar = succ (unifyNextVar s) }
148− return $ unifyNextVar st
149−
150−-- |
151−-- Generate a fresh unification variable at a specific type
152−--
153−fresh :: (Monad m, Partial t) => UnifyT t m t
154−fresh = do
155− u <- fresh'
156− return $ unknown u
157−
158−
159−
src/Language/PureScript.hsdeleted−262
@@ -1,262 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- The main compiler module
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DataKinds #-}
17−{-# LANGUAGE FlexibleContexts #-}
18−{-# LANGUAGE RecordWildCards #-}
19−{-# LANGUAGE ScopedTypeVariables #-}
20−
21−module Language.PureScript
22− ( module P
23− , compile
24− , compile'
25− , RebuildPolicy(..)
26− , MakeActions(..)
27− , SupplyVar()
28− , Externs()
29− , make
30− , version
31− ) where
32−
33−import Data.Function (on)
34−import Data.List (sortBy, groupBy, intercalate)
35−import Data.Maybe (fromMaybe)
36−import Data.Time.Clock
37−import Data.Version (Version)
38−import qualified Data.Map as M
39−import qualified Data.Set as S
40−
41−import Control.Applicative
42−import Control.Arrow ((&&&))
43−import Control.Monad
44−import Control.Monad.Error.Class (MonadError(..))
45−import Control.Monad.Reader
46−import Control.Monad.Writer
47−import Control.Monad.Supply.Class (fresh)
48−
49−import Language.PureScript.AST as P
50−import Language.PureScript.Comments as P
51−import Language.PureScript.CodeGen.Externs (moduleToPs)
52−import Language.PureScript.DeadCodeElimination as P
53−import Language.PureScript.Environment as P
54−import Language.PureScript.Errors as P
55−import Language.PureScript.Kinds as P
56−import Language.PureScript.Linter as P
57−import Language.PureScript.ModuleDependencies as P
58−import Language.PureScript.Names as P
59−import Language.PureScript.Options as P
60−import Language.PureScript.Parser as P
61−import Language.PureScript.Pretty as P
62−import Language.PureScript.Renamer as P
63−import Language.PureScript.Sugar as P
64−import Control.Monad.Supply as P
65−import Language.PureScript.TypeChecker as P
66−import Language.PureScript.Types as P
67−import qualified Language.PureScript.CoreFn as CoreFn
68−import qualified Language.PureScript.Constants as C
69−
70−import qualified Paths_purescript as Paths
71−
72−-- |
73−-- Compile a collection of modules
74−--
75−-- The compilation pipeline proceeds as follows:
76−--
77−-- * Sort the modules based on module dependencies, checking for cyclic dependencies.
78−--
79−-- * Perform a set of desugaring passes.
80−--
81−-- * Type check, and elaborate values to include type annotations and type class dictionaries.
82−--
83−-- * Regroup values to take into account new value dependencies introduced by elaboration.
84−--
85−-- * Eliminate dead code.
86−--
87−-- * Generate Javascript, and perform optimization passes.
88−--
89−-- * Pretty-print the generated Javascript
90−--
91−compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)
92− => [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)
93−compile = compile' initEnvironment
94−
95−compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)
96− => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)
97−compile' env ms = do
98− noPrelude <- asks optionsNoPrelude
99− unless noPrelude (checkPreludeIsDefined ms)
100− additional <- asks optionsAdditional
101− mainModuleIdent <- asks (fmap moduleNameFromString . optionsMain)
102− (sorted, _) <- sortModules $ map importPrim $ if noPrelude then ms else map importPrelude ms
103− mapM_ lint sorted
104− (desugared, nextVar) <- runSupplyT 0 $ desugar sorted
105− (elaborated, env') <- runCheck' env $ forM desugared $ typeCheckModule mainModuleIdent
106− regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
107− let corefn = map (CoreFn.moduleToCoreFn env') regrouped
108− entryPoints = moduleNameFromString `map` entryPointModules additional
109− elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn
110− renamed = renameInModules elim
111− codeGenModuleNames = moduleNameFromString `map` codeGenModules additional
112− modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed
113− exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
114− return (modulesToCodeGen, env', nextVar, exts)
115−
116−-- |
117−-- Actions that require implementations when running in "make" mode.
118−--
119−data MakeActions m = MakeActions {
120− -- |
121− -- Get the timestamp for the input file(s) for a module. If there are multiple
122− -- files (.purs and foreign files, for example) the timestamp should be for
123− -- the most recently modified file.
124− --
125− getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))
126− -- |
127− -- Get the timestamp for the output files for a module. This should be the
128− -- timestamp for the oldest modified file, or Nothing if any of the required
129− -- output files are missing.
130− --
131− , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)
132− -- |
133− -- Read the externs file for a module as a string and also return the actual
134− -- path for the file.
135− , readExterns :: ModuleName -> m (FilePath, String)
136− -- |
137− -- Run the code generator for the module and write any required output files.
138− --
139− , codegen :: CoreFn.Module CoreFn.Ann -> Environment -> SupplyVar -> Externs -> m ()
140− -- |
141− -- Respond to a progress update.
142− --
143− , progress :: String -> m ()
144− }
145−
146−-- |
147−-- Generated code for an externs file.
148−--
149−type Externs = String
150−
151−-- |
152−-- A value to be used in the Supply monad.
153−--
154−type SupplyVar = Integer
155−
156−-- |
157−-- Determines when to rebuild a module
158−--
159−data RebuildPolicy
160− -- | Never rebuild this module
161− = RebuildNever
162− -- | Always rebuild this module
163− | RebuildAlways deriving (Show, Eq, Ord)
164−
165−-- |
166−-- Compiles in "make" mode, compiling each module separately to a js files and an externs file
167−--
168−-- If timestamps have not changed, the externs file can be used to provide the module's types without
169−-- having to typecheck the module again.
170−--
171−make :: forall m. (Functor m, Applicative m, Monad m, MonadReader (P.Options P.Make) m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
172− => MakeActions m
173− -> [(Either RebuildPolicy FilePath, Module)]
174− -> m Environment
175−make MakeActions{..} ms = do
176− noPrelude <- asks optionsNoPrelude
177− unless noPrelude (checkPreludeIsDefined (map snd ms))
178− (sorted, graph) <- sortModules $ map importPrim $ if noPrelude then map snd ms else map (importPrelude . snd) ms
179− mapM_ lint sorted
180− toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do
181− inputTimestamp <- getInputTimestamp moduleName'
182− outputTimestamp <- getOutputTimestamp moduleName'
183− return $ case (inputTimestamp, outputTimestamp) of
184− (Right (Just t1), Just t2) | t1 < t2 -> s
185− (Left RebuildNever, Just _) -> s
186− _ -> S.insert moduleName' s) S.empty sorted
187−
188− marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted
189− (desugared, nextVar) <- runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)
190− evalSupplyT nextVar $ go initEnvironment desugared
191− where
192−
193− go :: Environment -> [(Bool, Module)] -> SupplyT m Environment
194− go env [] = return env
195− go env ((False, m) : ms') = do
196− (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m
197− go env' ms'
198− go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do
199− lift $ progress $ "Compiling " ++ runModuleName moduleName'
200− (Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m
201− regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated
202− let mod' = Module coms moduleName' regrouped exps
203− corefn = CoreFn.moduleToCoreFn env' mod'
204− [renamed] = renameInModules [corefn]
205− exts = moduleToPs mod' env'
206− nextVar <- fresh
207− lift $ codegen renamed env' nextVar exts
208− go env' ms'
209−
210− rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]
211− rebuildIfNecessary _ _ [] = return []
212− rebuildIfNecessary graph toRebuild (m@(Module _ moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do
213− let deps = fromMaybe [] $ moduleName' `M.lookup` graph
214− toRebuild' = toRebuild `S.union` S.fromList deps
215− (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'
216− rebuildIfNecessary graph toRebuild (Module _ moduleName' _ _ : ms') = do
217− (path, externs) <- readExterns moduleName'
218− externsModules <- fmap (map snd) . alterErrors $ P.parseModulesFromFiles id [(path, externs)]
219− case externsModules of
220− [m'@(Module _ moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
221− _ -> throwError . errorMessage . InvalidExternsFile $ path
222− where
223− alterErrors = flip catchError $ \(MultipleErrors errs) ->
224− throwError . MultipleErrors $ flip map errs $ \e -> case e of
225− SimpleErrorWrapper (ErrorParsingModule err) -> SimpleErrorWrapper (ErrorParsingExterns err)
226− _ -> e
227−
228−checkPreludeIsDefined :: (MonadWriter MultipleErrors m) => [Module] -> m ()
229−checkPreludeIsDefined ms = do
230− let mns = map getModuleName ms
231− unless (preludeModuleName `elem` mns) $
232− tell (errorMessage PreludeNotPresent)
233−
234−reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]
235−reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]
236− where
237− combine :: (Ord a) => [(a, b)] -> M.Map a [b]
238− combine = M.fromList . map ((fst . head) &&& map snd) . groupBy ((==) `on` fst) . sortBy (compare `on` fst)
239−
240−-- |
241−-- Add an import declaration for a module if it does not already explicitly import it.
242−--
243−addDefaultImport :: ModuleName -> Module -> Module
244−addDefaultImport toImport m@(Module coms mn decls exps) =
245− if isExistingImport `any` decls || mn == toImport then m
246− else Module coms mn (ImportDeclaration toImport Implicit Nothing : decls) exps
247− where
248− isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
249− isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d
250− isExistingImport _ = False
251−
252−importPrim :: Module -> Module
253−importPrim = addDefaultImport (ModuleName [ProperName C.prim])
254−
255−preludeModuleName :: ModuleName
256−preludeModuleName = ModuleName [ProperName C.prelude]
257−
258−importPrelude :: Module -> Module
259−importPrelude = addDefaultImport preludeModuleName
260−
261−version :: Version
262−version = Paths.version
src/Language/PureScript/AST.hsdeleted−24
@@ -1,24 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The initial PureScript AST
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.AST (
16− module AST
17−) where
18−
19−import Language.PureScript.AST.Binders as AST
20−import Language.PureScript.AST.Declarations as AST
21−import Language.PureScript.AST.Operators as AST
22−import Language.PureScript.AST.SourcePos as AST
23−import Language.PureScript.AST.Traversals as AST
24−import Language.PureScript.AST.Exported as AST
src/Language/PureScript/AST/Binders.hsdeleted−86
@@ -1,86 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.Binders
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Case binders
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−
17−module Language.PureScript.AST.Binders where
18−
19−import qualified Data.Data as D
20−
21−import Language.PureScript.AST.SourcePos
22−import Language.PureScript.Names
23−import Language.PureScript.Comments
24−
25−-- |
26−-- Data type for binders
27−--
28−data Binder
29− -- |
30− -- Wildcard binder
31− --
32− = NullBinder
33− -- |
34− -- A binder which matches a boolean literal
35− --
36− | BooleanBinder Bool
37− -- |
38− -- A binder which matches a string literal
39− --
40− | StringBinder String
41− -- |
42− -- A binder which matches a character literal
43− --
44− | CharBinder Char
45− -- |
46− -- A binder which matches a numeric literal
47− --
48− | NumberBinder (Either Integer Double)
49− -- |
50− -- A binder which binds an identifier
51− --
52− | VarBinder Ident
53− -- |
54− -- A binder which matches a data constructor
55− --
56− | ConstructorBinder (Qualified ProperName) [Binder]
57− -- |
58− -- A binder which matches a record and binds its properties
59− --
60− | ObjectBinder [(String, Binder)]
61− -- |
62− -- A binder which matches an array and binds its elements
63− --
64− | ArrayBinder [Binder]
65− -- |
66− -- A binder which binds its input to an identifier
67− --
68− | NamedBinder Ident Binder
69− -- |
70− -- A binder with source position information
71− --
72− | PositionedBinder SourceSpan [Comment] Binder deriving (Show, D.Data, D.Typeable)
73−
74−-- |
75−-- Collect all names introduced in binders in an expression
76−--
77−binderNames :: Binder -> [Ident]
78−binderNames = go []
79− where
80− go ns (VarBinder name) = name : ns
81− go ns (ConstructorBinder _ bs) = foldl go ns bs
82− go ns (ObjectBinder bs) = foldl go ns (map snd bs)
83− go ns (ArrayBinder bs) = foldl go ns bs
84− go ns (NamedBinder name b) = go (name : ns) b
85− go ns (PositionedBinder _ _ b) = go ns b
86− go ns _ = ns
src/Language/PureScript/AST/Declarations.hsdeleted−410
@@ -1,410 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.Declarations
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Data types for modules and declarations
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
16−
17−module Language.PureScript.AST.Declarations where
18−
19−import qualified Data.Data as D
20−
21−import Language.PureScript.AST.Binders
22−import Language.PureScript.AST.Operators
23−import Language.PureScript.AST.SourcePos
24−import Language.PureScript.Types
25−import Language.PureScript.Names
26−import Language.PureScript.Kinds
27−import Language.PureScript.TypeClassDictionaries
28−import Language.PureScript.Comments
29−import Language.PureScript.Environment
30−
31−-- |
32−-- A module declaration, consisting of comments about the module, a module name,
33−-- a list of declarations, and a list of the declarations that are
34−-- explicitly exported. If the export list is Nothing, everything is exported.
35−--
36−data Module = Module [Comment] ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
37−
38−-- | Return a module's name.
39−getModuleName :: Module -> ModuleName
40−getModuleName (Module _ name _ _) = name
41−
42−-- |
43−-- An item in a list of explicit imports or exports
44−--
45−data DeclarationRef
46− -- |
47− -- A type constructor with data constructors
48− --
49− = TypeRef ProperName (Maybe [ProperName])
50− -- |
51− -- A value
52− --
53− | ValueRef Ident
54− -- |
55− -- A type class
56− --
57− | TypeClassRef ProperName
58− -- |
59− -- A type class instance, created during typeclass desugaring (name, class name, instance types)
60− --
61− | TypeInstanceRef Ident
62− -- |
63− -- A declaration reference with source position information
64− --
65− | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
66− deriving (Show, D.Data, D.Typeable)
67−
68−instance Eq DeclarationRef where
69− (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
70− (ValueRef name) == (ValueRef name') = name == name'
71− (TypeClassRef name) == (TypeClassRef name') = name == name'
72− (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
73− (PositionedDeclarationRef _ _ r) == r' = r == r'
74− r == (PositionedDeclarationRef _ _ r') = r == r'
75− _ == _ = False
76−
77−-- |
78−-- The data type which specifies type of import declaration
79−--
80−data ImportDeclarationType
81− -- |
82− -- An import with no explicit list: `import M`
83− --
84− = Implicit
85− -- |
86− -- An import with an explicit list of references to import: `import M (foo)`
87− --
88− | Explicit [DeclarationRef]
89− -- |
90− -- An import with a list of references to hide: `import M hiding (foo)`
91− --
92− | Hiding [DeclarationRef]
93− deriving (Show, D.Data, D.Typeable)
94−
95−-- |
96−-- The data type of declarations
97−--
98−data Declaration
99− -- |
100− -- A data type declaration (data or newtype, name, arguments, data constructors)
101− --
102− = DataDeclaration DataDeclType ProperName [(String, Maybe Kind)] [(ProperName, [Type])]
103− -- |
104− -- A minimal mutually recursive set of data type declarations
105− --
106− | DataBindingGroupDeclaration [Declaration]
107− -- |
108− -- A type synonym declaration (name, arguments, type)
109− --
110− | TypeSynonymDeclaration ProperName [(String, Maybe Kind)] Type
111− -- |
112− -- A type declaration for a value (name, ty)
113− --
114− | TypeDeclaration Ident Type
115− -- |
116− -- A value declaration (name, top-level binders, optional guard, value)
117− --
118− | ValueDeclaration Ident NameKind [Binder] (Either [(Guard, Expr)] Expr)
119− -- |
120− -- A minimal mutually recursive set of value declarations
121− --
122− | BindingGroupDeclaration [(Ident, NameKind, Expr)]
123− -- |
124− -- A foreign import declaration (name, type)
125− --
126− | ExternDeclaration Ident Type
127− -- |
128− -- A data type foreign import (name, kind)
129− --
130− | ExternDataDeclaration ProperName Kind
131− -- |
132− -- A type class instance foreign import
133− --
134− | ExternInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type]
135− -- |
136− -- A fixity declaration (fixity data, operator name)
137− --
138− | FixityDeclaration Fixity String
139− -- |
140− -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
141− --
142− | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
143− -- |
144− -- A type class declaration (name, argument, implies, member declarations)
145− --
146− | TypeClassDeclaration ProperName [(String, Maybe Kind)] [Constraint] [Declaration]
147− -- |
148− -- A type instance declaration (name, dependencies, class name, instance types, member
149− -- declarations)
150− --
151− | TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] [Declaration]
152− -- |
153− -- A declaration with source position information
154− --
155− | PositionedDeclaration SourceSpan [Comment] Declaration
156− deriving (Show, D.Data, D.Typeable)
157−
158−-- |
159−-- Test if a declaration is a value declaration
160−--
161−isValueDecl :: Declaration -> Bool
162−isValueDecl ValueDeclaration{} = True
163−isValueDecl (PositionedDeclaration _ _ d) = isValueDecl d
164−isValueDecl _ = False
165−
166−-- |
167−-- Test if a declaration is a data type or type synonym declaration
168−--
169−isDataDecl :: Declaration -> Bool
170−isDataDecl DataDeclaration{} = True
171−isDataDecl TypeSynonymDeclaration{} = True
172−isDataDecl (PositionedDeclaration _ _ d) = isDataDecl d
173−isDataDecl _ = False
174−
175−-- |
176−-- Test if a declaration is a module import
177−--
178−isImportDecl :: Declaration -> Bool
179−isImportDecl ImportDeclaration{} = True
180−isImportDecl (PositionedDeclaration _ _ d) = isImportDecl d
181−isImportDecl _ = False
182−
183−-- |
184−-- Test if a declaration is a data type foreign import
185−--
186−isExternDataDecl :: Declaration -> Bool
187−isExternDataDecl ExternDataDeclaration{} = True
188−isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
189−isExternDataDecl _ = False
190−
191−-- |
192−-- Test if a declaration is a type class instance foreign import
193−--
194−isExternInstanceDecl :: Declaration -> Bool
195−isExternInstanceDecl ExternInstanceDeclaration{} = True
196−isExternInstanceDecl (PositionedDeclaration _ _ d) = isExternInstanceDecl d
197−isExternInstanceDecl _ = False
198−
199−-- |
200−-- Test if a declaration is a fixity declaration
201−--
202−isFixityDecl :: Declaration -> Bool
203−isFixityDecl FixityDeclaration{} = True
204−isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
205−isFixityDecl _ = False
206−
207−-- |
208−-- Test if a declaration is a foreign import
209−--
210−isExternDecl :: Declaration -> Bool
211−isExternDecl ExternDeclaration{} = True
212−isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
213−isExternDecl _ = False
214−
215−-- |
216−-- Test if a declaration is a type class instance declaration
217−--
218−isTypeClassInstanceDeclaration :: Declaration -> Bool
219−isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True
220−isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d
221−isTypeClassInstanceDeclaration _ = False
222−
223−-- |
224−-- Test if a declaration is a type class declaration
225−--
226−isTypeClassDeclaration :: Declaration -> Bool
227−isTypeClassDeclaration TypeClassDeclaration{} = True
228−isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d
229−isTypeClassDeclaration _ = False
230−
231−-- |
232−-- Recursively flatten data binding groups in the list of declarations
233−flattenDecls :: [Declaration] -> [Declaration]
234−flattenDecls = concatMap flattenOne
235− where flattenOne :: Declaration -> [Declaration]
236− flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls
237− flattenOne d = [d]
238−
239−-- |
240−-- A guard is just a boolean-valued expression that appears alongside a set of binders
241−--
242−type Guard = Expr
243−
244−-- |
245−-- Data type for expressions and terms
246−--
247−data Expr
248− -- |
249− -- A numeric literal
250− --
251− = NumericLiteral (Either Integer Double)
252− -- |
253− -- A string literal
254− --
255− | StringLiteral String
256− -- |
257− -- A character literal
258− --
259− | CharLiteral Char
260− -- |
261− -- A boolean literal
262− --
263− | BooleanLiteral Bool
264− -- |
265− -- A prefix -, will be desugared
266− --
267− | UnaryMinus Expr
268− -- |
269− -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
270− -- will be removed.
271− --
272− | BinaryNoParens Expr Expr Expr
273− -- |
274− -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor
275− -- will be removed.
276− --
277− | Parens Expr
278− -- |
279− -- Operator section. This will be removed during desugaring and replaced with a partially applied
280− -- operator or lambda to flip the arguments.
281− --
282− | OperatorSection Expr (Either Expr Expr)
283− -- |
284− -- An array literal
285− --
286− | ArrayLiteral [Expr]
287− -- |
288− -- An object literal
289− --
290− | ObjectLiteral [(String, Expr)]
291− -- |
292− -- An object constructor (object literal with underscores). This will be removed during
293− -- desugaring and expanded into a lambda that returns an object literal.
294− --
295− | ObjectConstructor [(String, Maybe Expr)]
296− -- |
297− -- An object property getter (e.g. `_.x`). This will be removed during
298− -- desugaring and expanded into a lambda that reads a property from an object.
299− --
300− | ObjectGetter String
301− -- |
302− -- An record property accessor expression
303− --
304− | Accessor String Expr
305− -- |
306− -- Partial record update
307− --
308− | ObjectUpdate Expr [(String, Expr)]
309− -- |
310− -- Partial record updater. This will be removed during desugaring and
311− -- expanded into a lambda that returns an object update.
312− --
313− | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]
314− -- |
315− -- Function introduction
316− --
317− | Abs (Either Ident Binder) Expr
318− -- |
319− -- Function application
320− --
321− | App Expr Expr
322− -- |
323− -- Variable
324− --
325− | Var (Qualified Ident)
326− -- |
327− -- Conditional (if-then-else expression)
328− --
329− | IfThenElse Expr Expr Expr
330− -- |
331− -- A data constructor
332− --
333− | Constructor (Qualified ProperName)
334− -- |
335− -- A case expression. During the case expansion phase of desugaring, top-level binders will get
336− -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
337− --
338− | Case [Expr] [CaseAlternative]
339− -- |
340− -- A value with a type annotation
341− --
342− | TypedValue Bool Expr Type
343− -- |
344− -- A let binding
345− --
346− | Let [Declaration] Expr
347− -- |
348− -- A do-notation block
349− --
350− | Do [DoNotationElement]
351− -- |
352− -- An application of a typeclass dictionary constructor. The value should be
353− -- an ObjectLiteral.
354− --
355− | TypeClassDictionaryConstructorApp (Qualified ProperName) Expr
356− -- |
357− -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
358− -- placeholders will be replaced with actual expressions representing type classes dictionaries which
359− -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
360− -- at superclass implementations when searching for a dictionary, the type class name and
361− -- instance type, and the type class dictionaries in scope.
362− --
363− | TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
364− -- |
365− -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
366− --
367− | TypeClassDictionaryAccessor (Qualified ProperName) Ident
368− -- |
369− -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
370− --
371− | SuperClassDictionary (Qualified ProperName) [Type]
372− -- |
373− -- A value with source position information
374− --
375− | PositionedValue SourceSpan [Comment] Expr deriving (Show, D.Data, D.Typeable)
376−
377−-- |
378−-- An alternative in a case statement
379−--
380−data CaseAlternative = CaseAlternative
381− { -- |
382− -- A collection of binders with which to match the inputs
383− --
384− caseAlternativeBinders :: [Binder]
385− -- |
386− -- The result expression or a collect of guarded expressions
387− --
388− , caseAlternativeResult :: Either [(Guard, Expr)] Expr
389− } deriving (Show, D.Data, D.Typeable)
390−
391−-- |
392−-- A statement in a do-notation block
393−--
394−data DoNotationElement
395− -- |
396− -- A monadic value without a binder
397− --
398− = DoNotationValue Expr
399− -- |
400− -- A monadic value with a binder
401− --
402− | DoNotationBind Binder Expr
403− -- |
404− -- A let statement, i.e. a pure value with a binder
405− --
406− | DoNotationLet [Declaration]
407− -- |
408− -- A do notation element with source position information
409− --
410− | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement deriving (Show, D.Data, D.Typeable)
src/Language/PureScript/AST/Exported.hsdeleted−132
@@ -1,132 +0,0 @@
1−
2−module Language.PureScript.AST.Exported (
3− exportedDeclarations,
4− isExported
5−) where
6−
7−import Control.Category ((>>>))
8−import Data.Maybe (mapMaybe)
9−
10−import Language.PureScript.AST.Declarations
11−import Language.PureScript.Types
12−import Language.PureScript.Names
13−
14−-- |
15−-- Return a list of all declarations which are exported from a module.
16−-- This function descends into data declarations to filter out unexported
17−-- data constructors, and also filters out type instance declarations if
18−-- they refer to classes or types which are not themselves exported.
19−--
20−-- Note that this function assumes that the module has already had its imports
21−-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
22−-- produce incorrect results if this is not the case - for example, type class
23−-- instances will be incorrectly removed in some cases.
24−--
25−exportedDeclarations :: Module -> [Declaration]
26−exportedDeclarations (Module _ _ decls exps) = go decls
27− where
28− go = flattenDecls
29− >>> filter (isExported exps)
30− >>> map (filterDataConstructors exps)
31− >>> filterInstances exps
32−
33−-- |
34−-- Filter out all data constructors from a declaration which are not exported.
35−-- If the supplied declaration is not a data declaration, this function returns
36−-- it unchanged.
37−--
38−filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
39−filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =
40− DataDeclaration dType tyName tyArgs $
41− filter (isDctorExported tyName exps . fst) dctors
42−filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =
43− PositionedDeclaration srcSpan coms (filterDataConstructors exps d)
44−filterDataConstructors _ other = other
45−
46−-- |
47−-- Filter out all the type instances from a list of declarations which
48−-- reference a type or type class which is both local and not exported.
49−--
50−-- Note that this function assumes that the module has already had its imports
51−-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
52−-- produce incorrect results if this is not the case - for example, type class
53−-- instances will be incorrectly removed in some cases.
54−--
55−filterInstances :: Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
56−filterInstances Nothing = id
57−filterInstances (Just exps) =
58− let refs = mapMaybe typeName exps ++ mapMaybe typeClassName exps
59− in filter (all (visibleOutside refs) . typeInstanceConstituents)
60− where
61− -- Given a Qualified ProperName, and a list of all exported types and type
62− -- classes, returns whether the supplied Qualified ProperName is visible
63− -- outside this module. This is true if one of the following hold:
64− --
65− -- * the name is defined in the same module and is exported,
66− -- * the name is defined in a different module (and must be exported from
67− -- that module; the code would fail to compile otherwise).
68− visibleOutside _ (Qualified (Just _) _) = True
69− visibleOutside refs (Qualified Nothing n) = any (== n) refs
70−
71− typeName (TypeRef n _) = Just n
72− typeName (PositionedDeclarationRef _ _ r) = typeName r
73− typeName _ = Nothing
74−
75− typeClassName (TypeClassRef n) = Just n
76− typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r
77− typeClassName _ = Nothing
78−
79−-- |
80−-- Get all type and type class names referenced by a type instance declaration.
81−--
82−typeInstanceConstituents :: Declaration -> [Qualified ProperName]
83−typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =
84− className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
85− where
86−
87− fromConstraint (name, tys') = name : concatMap fromType tys'
88− fromType = everythingOnTypes (++) go
89−
90− -- Note that type synonyms are disallowed in instance declarations, so
91− -- we don't need to handle them here.
92− go (TypeConstructor n) = [n]
93− go (ConstrainedType cs _) = concatMap fromConstraint cs
94− go _ = []
95−
96−typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d
97−typeInstanceConstituents _ = []
98−
99−
100−-- |
101−-- Test if a declaration is exported, given a module's export list. Prefer
102−-- 'exportedDeclarations' to this function, where possible.
103−--
104−isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
105−isExported Nothing _ = True
106−isExported _ TypeInstanceDeclaration{} = True
107−isExported exps (PositionedDeclaration _ _ d) = isExported exps d
108−isExported (Just exps) decl = any (matches decl) exps
109− where
110− matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
111− matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
112− matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'
113− matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
114− matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
115− matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
116− matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
117− matches (PositionedDeclaration _ _ d) r = d `matches` r
118− matches d (PositionedDeclarationRef _ _ r) = d `matches` r
119− matches _ _ = False
120−
121−-- |
122−-- Test if a data constructor for a given type is exported, given a module's
123−-- export list. Prefer 'exportedDeclarations' to this function, where possible.
124−--
125−isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
126−isDctorExported _ Nothing _ = True
127−isDctorExported ident (Just exps) ctor = test `any` exps
128− where
129− test (PositionedDeclarationRef _ _ d) = test d
130− test (TypeRef ident' Nothing) = ident == ident'
131− test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
132− test _ = False
src/Language/PureScript/AST/Operators.hsdeleted−39
@@ -1,39 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.Operators
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Operators fixity and associativity
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−
17−module Language.PureScript.AST.Operators where
18−
19−import qualified Data.Data as D
20−
21−-- |
22−-- A precedence level for an infix operator
23−--
24−type Precedence = Integer
25−
26−-- |
27−-- Associativity for infix operators
28−--
29−data Associativity = Infixl | Infixr | Infix deriving (D.Data, D.Typeable)
30−
31−instance Show Associativity where
32− show Infixl = "infixl"
33− show Infixr = "infixr"
34− show Infix = "infix"
35−
36−-- |
37−-- Fixity data for infix operators
38−--
39−data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)
src/Language/PureScript/AST/SourcePos.hsdeleted−71
@@ -1,71 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.SourcePos
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Source position information
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, RecordWildCards, OverloadedStrings #-}
16−
17−module Language.PureScript.AST.SourcePos where
18−
19−import qualified Data.Data as D
20−import Data.Aeson ((.=))
21−import qualified Data.Aeson as A
22−
23−-- |
24−-- Source position information
25−--
26−data SourcePos = SourcePos
27− { -- |
28− -- Line number
29− --
30− sourcePosLine :: Int
31− -- |
32− -- Column number
33− --
34− , sourcePosColumn :: Int
35− } deriving (Eq, Ord, Show, D.Data, D.Typeable)
36−
37−displaySourcePos :: SourcePos -> String
38−displaySourcePos sp =
39− "line " ++ show (sourcePosLine sp) ++
40− ", column " ++ show (sourcePosColumn sp)
41−
42−instance A.ToJSON SourcePos where
43− toJSON SourcePos{..} =
44− A.toJSON [sourcePosLine, sourcePosColumn]
45−
46−data SourceSpan = SourceSpan
47− { -- |
48− -- Source name
49− --
50− spanName :: String
51− -- |
52− -- Start of the span
53− --
54− , spanStart :: SourcePos
55− -- End of the span
56− --
57− , spanEnd :: SourcePos
58− } deriving (Eq, Ord, Show, D.Data, D.Typeable)
59−
60−displaySourceSpan :: SourceSpan -> String
61−displaySourceSpan sp =
62− spanName sp ++ " " ++
63− displaySourcePos (spanStart sp) ++ " - " ++
64− displaySourcePos (spanEnd sp)
65−
66−instance A.ToJSON SourceSpan where
67− toJSON SourceSpan{..} =
68− A.object [ "name" .= spanName
69− , "start" .= spanStart
70− , "end" .= spanEnd
71− ]
src/Language/PureScript/AST/Traversals.hsdeleted−401
@@ -1,401 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.Traversals
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | AST traversal helpers
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.AST.Traversals where
16−
17−import Data.Monoid (Monoid(..), mconcat)
18−import Data.Maybe (mapMaybe)
19−
20−import Control.Applicative
21−import Control.Monad
22−import Control.Arrow ((***), (+++), second)
23−
24−import Language.PureScript.AST.Binders
25−import Language.PureScript.AST.Declarations
26−import Language.PureScript.Types
27−import Language.PureScript.Traversals
28−
29−everywhereOnValues :: (Declaration -> Declaration) ->
30− (Expr -> Expr) ->
31− (Binder -> Binder) ->
32− (Declaration -> Declaration, Expr -> Expr, Binder -> Binder)
33−everywhereOnValues f g h = (f', g', h')
34− where
35− f' :: Declaration -> Declaration
36− f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))
37− f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) ((map (g' *** g') +++ g') val))
38− f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
39− f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))
40− f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (map f' ds))
41− f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))
42− f' other = f other
43−
44− g' :: Expr -> Expr
45− g' (UnaryMinus v) = g (UnaryMinus (g' v))
46− g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
47− g' (Parens v) = g (Parens (g' v))
48− g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))
49− g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))
50− g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))
51− g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))
52− g' (ObjectConstructor vs) = g (ObjectConstructor (map (second (fmap g')) vs))
53− g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
54− g' (Accessor prop v) = g (Accessor prop (g' v))
55− g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))
56− g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))
57− g' (Abs name v) = g (Abs name (g' v))
58− g' (App v1 v2) = g (App (g' v1) (g' v2))
59− g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))
60− g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))
61− g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
62− g' (Let ds v) = g (Let (map f' ds) (g' v))
63− g' (Do es) = g (Do (map handleDoNotationElement es))
64− g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))
65− g' other = g other
66−
67− h' :: Binder -> Binder
68− h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))
69− h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))
70− h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))
71− h' (NamedBinder name b) = h (NamedBinder name (h' b))
72− h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
73− h' other = h other
74−
75− handleCaseAlternative :: CaseAlternative -> CaseAlternative
76− handleCaseAlternative ca =
77− ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
78− , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
79− }
80−
81− handleDoNotationElement :: DoNotationElement -> DoNotationElement
82− handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)
83− handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)
84− handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)
85− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)
86−
87−everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>
88− (Declaration -> m Declaration) ->
89− (Expr -> m Expr) ->
90− (Binder -> m Binder) ->
91− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
92−everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
93− where
94− f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f' <=< f) ds
95− f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h' <=< h) bs <*> eitherM (mapM (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
96− f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
97− f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f' <=< f) ds
98− f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f' <=< f) ds
99− f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')
100− f' other = f other
101−
102− g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
103− g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
104− g' (Parens v) = Parens <$> (g v >>= g')
105− g' (OperatorSection op (Left v)) = OperatorSection <$> (g op >>= g') <*> (Left <$> (g v >>= g'))
106− g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))
107− g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs
108− g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs
109− g' (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g' <=< g)) vs
110− g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
111− g' (Accessor prop v) = Accessor prop <$> (g v >>= g')
112− g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs
113− g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> mapM (sndM $ maybeM (g' <=< g)) vs
114− g' (Abs name v) = Abs name <$> (g v >>= g')
115− g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')
116− g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')
117− g' (Case vs alts) = Case <$> mapM (g' <=< g) vs <*> mapM handleCaseAlternative alts
118− g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
119− g' (Let ds v) = Let <$> mapM (f' <=< f) ds <*> (g v >>= g')
120− g' (Do es) = Do <$> mapM handleDoNotationElement es
121− g' (PositionedValue pos com v) = PositionedValue pos com <$> (g v >>= g')
122− g' other = g other
123−
124− h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs
125− h' (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h' <=< h)) bs
126− h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs
127− h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
128− h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
129− h' other = h other
130−
131− handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM (h' <=< h) bs
132− <*> eitherM (mapM (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
133−
134− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v
135− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v
136− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM (f' <=< f) ds
137− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
138−
139−everywhereOnValuesM :: (Functor m, Applicative m, Monad m) =>
140− (Declaration -> m Declaration) ->
141− (Expr -> m Expr) ->
142− (Binder -> m Binder) ->
143− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
144−everywhereOnValuesM f g h = (f', g', h')
145− where
146− f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> mapM f' ds) >>= f
147− f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> mapM h' bs <*> eitherM (mapM (pairM g' g')) g' val) >>= f
148− f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f
149− f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> mapM f' ds) >>= f
150− f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> mapM f' ds) >>= f
151− f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f
152− f' other = f other
153−
154− g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
155− g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
156− g' (Parens v) = (Parens <$> g' v) >>= g
157− g' (OperatorSection op (Left v)) = (OperatorSection <$> g' op <*> (Left <$> g' v)) >>= g
158− g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g
159− g' (ArrayLiteral vs) = (ArrayLiteral <$> mapM g' vs) >>= g
160− g' (ObjectLiteral vs) = (ObjectLiteral <$> mapM (sndM g') vs) >>= g
161− g' (ObjectConstructor vs) = (ObjectConstructor <$> mapM (sndM $ maybeM g') vs) >>= g
162− g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
163− g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g
164− g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g
165− g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> mapM (sndM $ maybeM g') vs) >>= g
166− g' (Abs name v) = (Abs name <$> g' v) >>= g
167− g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g
168− g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g
169− g' (Case vs alts) = (Case <$> mapM g' vs <*> mapM handleCaseAlternative alts) >>= g
170− g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
171− g' (Let ds v) = (Let <$> mapM f' ds <*> g' v) >>= g
172− g' (Do es) = (Do <$> mapM handleDoNotationElement es) >>= g
173− g' (PositionedValue pos com v) = (PositionedValue pos com <$> g' v) >>= g
174− g' other = g other
175−
176− h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h
177− h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h
178− h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h
179− h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
180− h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
181− h' other = h other
182−
183− handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM h' bs
184− <*> eitherM (mapM (pairM g' g')) g' val
185−
186− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v
187− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v
188− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM f' ds
189− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
190−
191−everythingOnValues :: (r -> r -> r) ->
192− (Declaration -> r) ->
193− (Expr -> r) ->
194− (Binder -> r) ->
195− (CaseAlternative -> r) ->
196− (DoNotationElement -> r) ->
197− (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
198−everythingOnValues (<>) f g h i j = (f', g', h', i', j')
199− where
200− f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)
201− f' d@(ValueDeclaration _ _ bs (Right val)) = foldl (<>) (f d) (map h' bs) <> g' val
202− f' d@(ValueDeclaration _ _ bs (Left gs)) = foldl (<>) (f d) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
203− f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)
204− f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)
205− f' d@(TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)
206− f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1
207− f' d = f d
208−
209− g' v@(UnaryMinus v1) = g v <> g' v1
210− g' v@(BinaryNoParens op v1 v2) = g v <> g op <> g' v1 <> g' v2
211− g' v@(Parens v1) = g v <> g' v1
212− g' v@(OperatorSection op (Left v1)) = g v <> g op <> g' v1
213− g' v@(OperatorSection op (Right v1)) = g v <> g op <> g' v1
214− g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)
215− g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)
216− g' v@(ObjectConstructor vs) = foldl (<>) (g v) (map g' (mapMaybe snd vs))
217− g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
218− g' v@(Accessor _ v1) = g v <> g' v1
219− g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
220− g' v@(ObjectUpdater obj vs) = foldl (<>) (maybe (g v) (\x -> g v <> g' x) obj) (map g' (mapMaybe snd vs))
221− g' v@(Abs _ v1) = g v <> g' v1
222− g' v@(App v1 v2) = g v <> g' v1 <> g' v2
223− g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3
224− g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
225− g' v@(TypedValue _ v1 _) = g v <> g' v1
226− g' v@(Let ds v1) = foldl (<>) (g v) (map f' ds) <> g' v1
227− g' v@(Do es) = foldl (<>) (g v) (map j' es)
228− g' v@(PositionedValue _ _ v1) = g v <> g' v1
229− g' v = g v
230−
231− h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)
232− h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)
233− h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)
234− h' b@(NamedBinder _ b1) = h b <> h' b1
235− h' b@(PositionedBinder _ _ b1) = h b <> h' b1
236− h' b = h b
237−
238− i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
239− i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
240−
241− j' e@(DoNotationValue v) = j e <> g' v
242− j' e@(DoNotationBind b v) = j e <> h' b <> g' v
243− j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)
244− j' e@(PositionedDoNotationElement _ _ e1) = j e <> j' e1
245−
246−everythingWithContextOnValues ::
247− s ->
248− r ->
249− (r -> r -> r) ->
250− (s -> Declaration -> (s, r)) ->
251− (s -> Expr -> (s, r)) ->
252− (s -> Binder -> (s, r)) ->
253− (s -> CaseAlternative -> (s, r)) ->
254− (s -> DoNotationElement -> (s, r)) ->
255− ( Declaration -> r
256− , Expr -> r
257− , Binder -> r
258− , CaseAlternative -> r
259− , DoNotationElement -> r)
260−everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
261− where
262− f'' s d = let (s', r) = f s d in r <> f' s' d
263−
264− f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (map (f'' s) ds)
265− f' s (ValueDeclaration _ _ bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
266− f' s (ValueDeclaration _ _ bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
267− f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)
268− f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
269− f' s (TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
270− f' s (PositionedDeclaration _ _ d1) = f'' s d1
271− f' _ _ = r0
272−
273− g'' s v = let (s', r) = g s v in r <> g' s' v
274−
275− g' s (UnaryMinus v1) = g'' s v1
276− g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
277− g' s (Parens v1) = g'' s v1
278− g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v
279− g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v
280− g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)
281− g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)
282− g' s (ObjectConstructor vs) = foldl (<>) r0 (map (g'' s) (mapMaybe snd vs))
283− g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
284− g' s (Accessor _ v1) = g'' s v1
285− g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)
286− g' s (ObjectUpdater obj vs) = foldl (<>) (maybe r0 (g'' s) obj) (map (g'' s) (mapMaybe snd vs))
287− g' s (Abs _ v1) = g'' s v1
288− g' s (App v1 v2) = g'' s v1 <> g'' s v2
289− g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
290− g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (map (g'' s) vs)) (map (i'' s) alts)
291− g' s (TypedValue _ v1 _) = g'' s v1
292− g' s (Let ds v1) = foldl (<>) r0 (map (f'' s) ds) <> g'' s v1
293− g' s (Do es) = foldl (<>) r0 (map (j'' s) es)
294− g' s (PositionedValue _ _ v1) = g'' s v1
295− g' _ _ = r0
296−
297− h'' s b = let (s', r) = h s b in r <> h' s' b
298−
299− h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)
300− h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)
301− h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
302− h' s (NamedBinder _ b1) = h'' s b1
303− h' s (PositionedBinder _ _ b1) = h'' s b1
304− h' _ _ = r0
305−
306− i'' s ca = let (s', r) = i s ca in r <> i' s' ca
307−
308− i' s (CaseAlternative bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
309− i' s (CaseAlternative bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
310−
311− j'' s e = let (s', r) = j s e in r <> j' s' e
312−
313− j' s (DoNotationValue v) = g'' s v
314− j' s (DoNotationBind b v) = h'' s b <> g'' s v
315− j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
316− j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
317−
318−everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>
319− s ->
320− (s -> Declaration -> m (s, Declaration)) ->
321− (s -> Expr -> m (s, Expr)) ->
322− (s -> Binder -> m (s, Binder)) ->
323− (s -> CaseAlternative -> m (s, CaseAlternative)) ->
324− (s -> DoNotationElement -> m (s, DoNotationElement)) ->
325− ( Declaration -> m Declaration
326− , Expr -> m Expr
327− , Binder -> m Binder
328− , CaseAlternative -> m CaseAlternative
329− , DoNotationElement -> m DoNotationElement)
330−everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
331− where
332− f'' s = uncurry f' <=< f s
333−
334− f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f'' s) ds
335− f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h'' s) bs <*> eitherM (mapM (pairM (g'' s) (g'' s))) (g'' s) val
336− f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (thirdM (g'' s)) ds
337− f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f'' s) ds
338− f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f'' s) ds
339− f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1
340− f' _ other = return other
341−
342− g'' s = uncurry g' <=< g s
343−
344− g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
345− g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
346− g' s (Parens v) = Parens <$> g'' s v
347− g' s (OperatorSection op (Left v)) = OperatorSection <$> g'' s op <*> (Left <$> g'' s v)
348− g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)
349− g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs
350− g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs
351− g' s (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g'' s)) vs
352− g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v
353− g' s (Accessor prop v) = Accessor prop <$> g'' s v
354− g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs
355− g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> mapM (sndM $ maybeM (g'' s)) vs
356− g' s (Abs name v) = Abs name <$> g'' s v
357− g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
358− g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
359− g' s (Case vs alts) = Case <$> mapM (g'' s) vs <*> mapM (i'' s) alts
360− g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
361− g' s (Let ds v) = Let <$> mapM (f'' s) ds <*> g'' s v
362− g' s (Do es) = Do <$> mapM (j'' s) es
363− g' s (PositionedValue pos com v) = PositionedValue pos com <$> g'' s v
364− g' _ other = return other
365−
366− h'' s = uncurry h' <=< h s
367−
368− h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h'' s) bs
369− h' s (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h'' s)) bs
370− h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs
371− h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
372− h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
373− h' _ other = return other
374−
375− i'' s = uncurry i' <=< i s
376−
377− i' s (CaseAlternative bs val) = CaseAlternative <$> mapM (h'' s) bs <*> eitherM (mapM (pairM (g'' s) (g'' s))) (g'' s) val
378−
379− j'' s = uncurry j' <=< j s
380−
381− j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
382− j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
383− j' s (DoNotationLet ds) = DoNotationLet <$> mapM (f'' s) ds
384− j' s (PositionedDoNotationElement pos com e1) = PositionedDoNotationElement pos com <$> j'' s e1
385−
386−accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
387−accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
388− where
389− forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
390− forDecls (ExternDeclaration _ ty) = f ty
391− forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
392− forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
393− forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
394− forDecls (TypeSynonymDeclaration _ _ ty) = f ty
395− forDecls (TypeDeclaration _ ty) = f ty
396− forDecls _ = mempty
397−
398− forValues (TypeClassDictionary _ (_, cs) _) = mconcat (map f cs)
399− forValues (SuperClassDictionary _ tys) = mconcat (map f tys)
400− forValues (TypedValue _ _ ty) = f ty
401− forValues _ = mempty
src/Language/PureScript/CodeGen.hsdeleted−25
@@ -1,25 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- A collection of modules related to code generation:
13−--
14−-- [@Language.PureScript.CodeGen.JS@] Code generator for Javascript
15−--
16−-- [@Language.PureScript.CodeGen.Externs@] Code generator for extern (foreign import) files
17−--
18−-- [@Language.PureScript.CodeGen.Optimize@] Optimization passes for generated Javascript
19−--
20−-----------------------------------------------------------------------------
21−
22−module Language.PureScript.CodeGen (module C) where
23−
24−import Language.PureScript.CodeGen.JS as C
25−import Language.PureScript.CodeGen.Externs as C
src/Language/PureScript/CodeGen/Externs.hsdeleted−121
@@ -1,121 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Externs
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module generates code for \"externs\" files, i.e. files containing only foreign import declarations.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.Externs (
17− moduleToPs
18−) where
19−
20−import Data.List (intercalate, find)
21−import Data.Maybe (fromMaybe, mapMaybe)
22−import qualified Data.Map as M
23−
24−import Control.Monad.Writer
25−
26−import Language.PureScript.AST
27−import Language.PureScript.Comments
28−import Language.PureScript.Environment
29−import Language.PureScript.Kinds
30−import Language.PureScript.Names
31−import Language.PureScript.Pretty
32−import Language.PureScript.TypeClassDictionaries
33−import Language.PureScript.Types
34−
35−-- |
36−-- Generate foreign imports for all declarations in a module
37−--
38−moduleToPs :: Module -> Environment -> String
39−moduleToPs (Module _ _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
40−moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
41− tell [ "module " ++ runModuleName moduleName ++ " where"]
42− mapM_ declToPs ds
43− mapM_ exportToPs exts
44− where
45−
46− declToPs :: Declaration -> Writer [String] ()
47− declToPs (ImportDeclaration mn _ _) = tell ["import " ++ show mn ++ " ()"]
48− declToPs (FixityDeclaration (Fixity assoc prec) op) =
49− case find exportsOp exts of
50− Nothing -> return ()
51− Just _ -> tell [ unwords [ show assoc, show prec, op ] ]
52− where
53− exportsOp :: DeclarationRef -> Bool
54− exportsOp (PositionedDeclarationRef _ _ r) = exportsOp r
55− exportsOp (ValueRef ident') = ident' == Op op
56− exportsOp _ = False
57− declToPs (PositionedDeclaration _ com d) = mapM_ commentToPs com >> declToPs d
58− declToPs _ = return ()
59−
60− commentToPs :: Comment -> Writer [String] ()
61− commentToPs (LineComment s) = tell ["-- " ++ s]
62− commentToPs (BlockComment s) = tell ["{- " ++ s ++ " -}"]
63−
64− exportToPs :: DeclarationRef -> Writer [String] ()
65− exportToPs (PositionedDeclarationRef _ _ r) = exportToPs r
66− exportToPs (TypeRef pn dctors) =
67− case Qualified (Just moduleName) pn `M.lookup` types env of
68− Nothing -> error $ show pn ++ " has no kind in exportToPs"
69− Just (kind, ExternData) ->
70− tell ["foreign import data " ++ show pn ++ " :: " ++ prettyPrintKind kind]
71− Just (_, DataType args tys) -> do
72− let dctors' = fromMaybe (map fst tys) dctors
73− printDctor dctor = case dctor `lookup` tys of
74− Nothing -> Nothing
75− Just tyArgs -> Just $ show dctor ++ " " ++ unwords (map prettyPrintTypeAtom tyArgs)
76− let dtype = if length dctors' == 1 && isNewtypeConstructor env (Qualified (Just moduleName) $ head dctors')
77− then "newtype"
78− else "data"
79− typeName = prettyPrintType $ foldl TypeApp (TypeConstructor (Qualified Nothing pn)) (map toTypeVar args)
80− tell [dtype ++ " " ++ typeName ++ (if null dctors' then "" else " = " ++ intercalate " | " (mapMaybe printDctor dctors'))]
81− Just (_, TypeSynonym) ->
82− case Qualified (Just moduleName) pn `M.lookup` typeSynonyms env of
83− Nothing -> error $ show pn ++ " has no type synonym info in exportToPs"
84− Just (args, synTy) ->
85− let
86− typeName = prettyPrintType $ foldl TypeApp (TypeConstructor (Qualified Nothing pn)) (map toTypeVar args)
87− in tell ["type " ++ typeName ++ " = " ++ prettyPrintType synTy]
88− _ -> error "Invalid input in exportToPs"
89−
90− exportToPs (ValueRef ident) =
91− case (moduleName, ident) `M.lookup` names env of
92− Nothing -> error $ show ident ++ " has no type in exportToPs"
93− Just (ty, nk, _) | nk == Public || nk == External ->
94− tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]
95− _ -> return ()
96− exportToPs (TypeClassRef className) =
97− case Qualified (Just moduleName) className `M.lookup` typeClasses env of
98− Nothing -> error $ show className ++ " has no type class definition in exportToPs"
99− Just (args, members, implies) -> do
100− let impliesString = if null implies
101− then ""
102− else "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) implies) ++ ") <= "
103− typeName = prettyPrintType $ foldl TypeApp (TypeConstructor (Qualified Nothing className)) (map toTypeVar args)
104− tell ["class " ++ impliesString ++ typeName ++ " where"]
105− forM_ (filter (isValueExported . fst) members) $ \(member ,ty) ->
106− tell [ " " ++ show member ++ " :: " ++ prettyPrintType ty ]
107−
108− exportToPs (TypeInstanceRef ident) = do
109− let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =
110− fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find (\tcd -> tcdName tcd == Qualified (Just moduleName) ident && tcdType tcd == TCDRegular) $ M.elems $ typeClassDictionaries env
111− let constraintsText = case fromMaybe [] deps of
112− [] -> ""
113− cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) cs) ++ ") => "
114− tell ["foreign import instance " ++ show ident ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)]
115−
116− toTypeVar :: (String, Maybe Kind) -> Type
117− toTypeVar (s, Nothing) = TypeVar s
118− toTypeVar (s, Just k) = KindedType (TypeVar s) k
119−
120− isValueExported :: Ident -> Bool
121− isValueExported ident = ValueRef ident `elem` exts
src/Language/PureScript/CodeGen/JS.hsdeleted−369
@@ -1,369 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module generates code in the simplified Javascript intermediate representation from Purescript code
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE GADTs #-}
17−{-# LANGUAGE ViewPatterns #-}
18−{-# LANGUAGE FlexibleContexts #-}
19−{-# LANGUAGE ScopedTypeVariables #-}
20−
21−module Language.PureScript.CodeGen.JS
22− ( module AST
23− , module Common
24− , moduleToJs
25− , mainCall
26− ) where
27−
28−import Data.List ((\\), delete, intersect)
29−import qualified Data.Traversable as T (traverse)
30−
31−import Control.Applicative
32−import Control.Arrow ((&&&))
33−import Control.Monad (replicateM, forM)
34−import Control.Monad.Reader (MonadReader, asks)
35−import Control.Monad.Supply.Class
36−
37−import Language.PureScript.AST.SourcePos
38−import Language.PureScript.CodeGen.JS.AST as AST
39−import Language.PureScript.CodeGen.JS.Common as Common
40−import Language.PureScript.CoreFn
41−import Language.PureScript.Names
42−import Language.PureScript.CodeGen.JS.Optimizer
43−import Language.PureScript.Options
44−import Language.PureScript.Traversals (sndM)
45−import qualified Language.PureScript.Constants as C
46−
47−-- |
48−-- Generate code in the simplified Javascript intermediate representation for all declarations in a
49−-- module.
50−--
51−moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)
52− => Module Ann -> Maybe JS -> m [JS]
53−moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
54− additional <- asks optionsAdditional
55− jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
56− jsDecls <- mapM bindToJs decls
57− optimized <- T.traverse (T.traverse optimize) jsDecls
58− let isModuleEmpty = null exps
59− comments <- not <$> asks optionsNoComments
60− let strict = JSStringLiteral "use strict"
61− let header = if comments && not (null coms) then JSComment coms strict else strict
62− let foreign' = [JSVariableIntroduction "$foreign" foreign | not $ null foreigns || foreign == Nothing]
63− let moduleBody = header : foreign' ++ jsImports ++ concat optimized
64− let foreignExps = exps `intersect` (fst `map` foreigns)
65− let standardExps = exps \\ foreignExps
66− let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
67− ++ map (runIdent &&& foreignIdent) foreignExps
68− return $ case additional of
69− MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
70− CompileOptions ns _ _ | not isModuleEmpty ->
71− [ JSVariableIntroduction ns
72− (Just (JSBinary Or (JSVar ns) (JSObjectLiteral [])) )
73− , JSAssignment (JSAccessor (moduleNameToJs mn) (JSVar ns))
74− (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn exps']))) [])
75− ]
76− _ -> []
77−
78− where
79−
80− -- |
81− -- Generates Javascript code for a module import.
82− --
83− importToJs :: ModuleName -> m JS
84− importToJs mn' = do
85− additional <- asks optionsAdditional
86− let moduleBody = case additional of
87− MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn')]
88− CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn') (JSVar ns)
89− return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
90−
91− -- |
92− -- Generate code in the simplified Javascript intermediate representation for a declaration
93− --
94− bindToJs :: Bind Ann -> m [JS]
95− bindToJs (NonRec ident val) = return <$> nonRecToJS ident val
96− bindToJs (Rec vals) = forM vals (uncurry nonRecToJS)
97−
98− -- |
99− -- Generate code in the simplified Javascript intermediate representation for a single non-recursive
100− -- declaration.
101− --
102− -- The main purpose of this function is to handle code generation for comments.
103− --
104− nonRecToJS :: Ident -> Expr Ann -> m JS
105− nonRecToJS i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
106− withoutComment <- asks optionsNoComments
107− if withoutComment
108− then nonRecToJS i (modifyAnn removeComments e)
109− else JSComment com <$> nonRecToJS i (modifyAnn removeComments e)
110− nonRecToJS ident val = do
111− js <- valueToJs val
112− return $ JSVariableIntroduction (identToJs ident) (Just js)
113−
114− -- |
115− -- Generate code in the simplified Javascript intermediate representation for a variable based on a
116− -- PureScript identifier.
117− --
118− var :: Ident -> JS
119− var = JSVar . identToJs
120−
121− -- |
122− -- Generate code in the simplified Javascript intermediate representation for an accessor based on
123− -- a PureScript identifier. If the name is not valid in Javascript (symbol based, reserved name) an
124− -- indexer is returned.
125− --
126− accessor :: Ident -> JS -> JS
127− accessor (Ident prop) = accessorString prop
128− accessor (Op op) = JSIndexer (JSStringLiteral op)
129−
130− accessorString :: String -> JS -> JS
131− accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)
132− | otherwise = JSAccessor prop
133−
134− -- |
135− -- Generate code in the simplified Javascript intermediate representation for a value or expression.
136− --
137− valueToJs :: Expr Ann -> m JS
138− valueToJs (Literal _ l) =
139− literalToValueJS l
140− valueToJs (Var (_, _, _, Just (IsConstructor _ [])) name) =
141− return $ JSAccessor "value" $ qualifiedToJS id name
142− valueToJs (Var (_, _, _, Just (IsConstructor _ _)) name) =
143− return $ JSAccessor "create" $ qualifiedToJS id name
144− valueToJs (Accessor _ prop val) =
145− accessorString prop <$> valueToJs val
146− valueToJs (ObjectUpdate _ o ps) = do
147− obj <- valueToJs o
148− sts <- mapM (sndM valueToJs) ps
149− extendObj obj sts
150− valueToJs e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
151− let args = unAbs e
152− in return $ JSFunction Nothing (map identToJs args) (JSBlock $ map assign args)
153− where
154− unAbs :: Expr Ann -> [Ident]
155− unAbs (Abs _ arg val) = arg : unAbs val
156− unAbs _ = []
157− assign :: Ident -> JS
158− assign name = JSAssignment (accessorString (runIdent name) (JSVar "this"))
159− (var name)
160− valueToJs (Abs _ arg val) = do
161− ret <- valueToJs val
162− return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
163− valueToJs e@App{} = do
164− let (f, args) = unApp e []
165− args' <- mapM valueToJs args
166− case f of
167− Var (_, _, _, Just IsNewtype) _ -> return (head args')
168− Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields ->
169− return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
170− Var (_, _, _, Just IsTypeClassConstructor) name ->
171− return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
172− _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs f
173− where
174− unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
175− unApp (App _ val arg) args = unApp val (arg : args)
176− unApp other args = (other, args)
177− valueToJs (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =
178− return $ if mn' == mn
179− then foreignIdent ident
180− else varToJs qi
181− valueToJs (Var (_, _, _, Just IsForeign) ident) =
182− error $ "Encountered an unqualified reference to a foreign ident " ++ show ident
183− valueToJs (Var _ ident) =
184− return $ varToJs ident
185− valueToJs (Case (maybeSpan, _, _, _) values binders) = do
186− vals <- mapM valueToJs values
187− bindersToJs maybeSpan binders vals
188− valueToJs (Let _ ds val) = do
189− ds' <- concat <$> mapM bindToJs ds
190− ret <- valueToJs val
191− return $ JSApp (JSFunction Nothing [] (JSBlock (ds' ++ [JSReturn ret]))) []
192− valueToJs (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =
193− return $ JSVariableIntroduction ctor (Just $
194− JSObjectLiteral [("create",
195− JSFunction Nothing ["value"]
196− (JSBlock [JSReturn $ JSVar "value"]))])
197− valueToJs (Constructor _ _ (ProperName ctor) []) =
198− return $ iife ctor [ JSFunction (Just ctor) [] (JSBlock [])
199− , JSAssignment (JSAccessor "value" (JSVar ctor))
200− (JSUnary JSNew $ JSApp (JSVar ctor) []) ]
201− valueToJs (Constructor _ _ (ProperName ctor) fields) =
202− let constructor =
203− let body = [ JSAssignment (JSAccessor (identToJs f) (JSVar "this")) (var f) | f <- fields ]
204− in JSFunction (Just ctor) (identToJs `map` fields) (JSBlock body)
205− createFn =
206− let body = JSUnary JSNew $ JSApp (JSVar ctor) (var `map` fields)
207− in foldr (\f inner -> JSFunction Nothing [identToJs f] (JSBlock [JSReturn inner])) body fields
208− in return $ iife ctor [ constructor
209− , JSAssignment (JSAccessor "create" (JSVar ctor)) createFn
210− ]
211−
212− iife :: String -> [JS] -> JS
213− iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
214−
215− literalToValueJS :: Literal (Expr Ann) -> m JS
216− literalToValueJS (NumericLiteral n) = return $ JSNumericLiteral n
217− literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
218− literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
219− literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral b
220− literalToValueJS (ArrayLiteral xs) = JSArrayLiteral <$> mapM valueToJs xs
221− literalToValueJS (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM valueToJs) ps
222−
223− -- |
224− -- Shallow copy an object.
225− --
226− extendObj :: JS -> [(String, JS)] -> m JS
227− extendObj obj sts = do
228− newObj <- freshName
229− key <- freshName
230− let
231− jsKey = JSVar key
232− jsNewObj = JSVar newObj
233− block = JSBlock (objAssign:copy:extend ++ [JSReturn jsNewObj])
234− objAssign = JSVariableIntroduction newObj (Just $ JSObjectLiteral [])
235− copy = JSForIn key obj $ JSBlock [JSIfElse cond assign Nothing]
236− cond = JSApp (JSAccessor "hasOwnProperty" obj) [jsKey]
237− assign = JSBlock [JSAssignment (JSIndexer jsKey jsNewObj) (JSIndexer jsKey obj)]
238− stToAssign (s, js) = JSAssignment (JSAccessor s jsNewObj) js
239− extend = map stToAssign sts
240− return $ JSApp (JSFunction Nothing [] block) []
241−
242− -- |
243− -- Generate code in the simplified Javascript intermediate representation for a reference to a
244− -- variable.
245− --
246− varToJs :: Qualified Ident -> JS
247− varToJs (Qualified Nothing ident) = var ident
248− varToJs qual = qualifiedToJS id qual
249−
250− -- |
251− -- Generate code in the simplified Javascript intermediate representation for a reference to a
252− -- variable that may have a qualified name.
253− --
254− qualifiedToJS :: (a -> Ident) -> Qualified a -> JS
255− qualifiedToJS f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = JSVar . runIdent $ f a
256− qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))
257− qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a)
258−
259− foreignIdent :: Ident -> JS
260− foreignIdent ident = accessorString (runIdent ident) (JSVar "$foreign")
261−
262− -- |
263− -- Generate code in the simplified Javascript intermediate representation for pattern match binders
264− -- and guards.
265− --
266− bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [JS] -> m JS
267− bindersToJs maybeSpan binders vals = do
268− valNames <- replicateM (length vals) freshName
269− let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
270− jss <- forM binders $ \(CaseAlternative bs result) -> do
271− ret <- guardsToJs result
272− go valNames ret bs
273− return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ failedPatternError valNames])))
274− []
275− where
276− go :: [String] -> [JS] -> [Binder Ann] -> m [JS]
277− go _ done [] = return done
278− go (v:vs) done' (b:bs) = do
279− done'' <- go vs done' bs
280− binderToJs v done'' b
281− go _ _ _ = error "Invalid arguments to bindersToJs"
282−
283− failedPatternError :: [String] -> JS
284− failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]
285−
286− errorMessage :: String
287− errorMessage = "Failed pattern match" ++ maybe "" ((" at " ++) . displaySourceSpan) maybeSpan ++ ": "
288−
289− valueError :: String -> JS -> JS
290− valueError _ l@(JSNumericLiteral _) = l
291− valueError _ l@(JSStringLiteral _) = l
292− valueError _ l@(JSBooleanLiteral _) = l
293− valueError s _ = JSAccessor "name" . JSAccessor "constructor" $ JSVar s
294−
295− guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]
296− guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
297− cond' <- valueToJs cond
298− done <- valueToJs val
299− return $ JSIfElse cond' (JSBlock [JSReturn done]) Nothing
300− guardsToJs (Right v) = return . JSReturn <$> valueToJs v
301−
302− -- |
303− -- Generate code in the simplified Javascript intermediate representation for a pattern match
304− -- binder.
305− --
306− binderToJs :: String -> [JS] -> Binder Ann -> m [JS]
307− binderToJs _ done (NullBinder{}) = return done
308− binderToJs varName done (LiteralBinder _ l) =
309− literalToBinderJS varName done l
310− binderToJs varName done (VarBinder _ ident) =
311− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
312− binderToJs varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
313− binderToJs varName done b
314− binderToJs varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do
315− js <- go (zip fields bs) done
316− return $ case ctorType of
317− ProductType -> js
318− SumType ->
319− [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS (Ident . runProperName) ctor))
320− (JSBlock js)
321− Nothing]
322− where
323− go :: [(Ident, Binder Ann)] -> [JS] -> m [JS]
324− go [] done' = return done'
325− go ((field, binder) : remain) done' = do
326− argVar <- freshName
327− done'' <- go remain done'
328− js <- binderToJs argVar done'' binder
329− return (JSVariableIntroduction argVar (Just (JSAccessor (identToJs field) (JSVar varName))) : js)
330− binderToJs _ _ b@(ConstructorBinder{}) =
331− error $ "Invalid ConstructorBinder in binderToJs: " ++ show b
332− binderToJs varName done (NamedBinder _ ident binder) = do
333− js <- binderToJs varName done binder
334− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
335−
336− literalToBinderJS :: String -> [JS] -> Literal (Binder Ann) -> m [JS]
337− literalToBinderJS varName done (NumericLiteral num) =
338− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
339− literalToBinderJS varName done (CharLiteral c) =
340− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral [c])) (JSBlock done) Nothing]
341− literalToBinderJS varName done (StringLiteral str) =
342− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
343− literalToBinderJS varName done (BooleanLiteral True) =
344− return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
345− literalToBinderJS varName done (BooleanLiteral False) =
346− return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
347− literalToBinderJS varName done (ObjectLiteral bs) = go done bs
348− where
349− go :: [JS] -> [(String, Binder Ann)] -> m [JS]
350− go done' [] = return done'
351− go done' ((prop, binder):bs') = do
352− propVar <- freshName
353− done'' <- go done' bs'
354− js <- binderToJs propVar done'' binder
355− return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
356− literalToBinderJS varName done (ArrayLiteral bs) = do
357− js <- go done 0 bs
358− return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
359− where
360− go :: [JS] -> Integer -> [Binder Ann] -> m [JS]
361− go done' _ [] = return done'
362− go done' index (binder:bs') = do
363− elVar <- freshName
364− done'' <- go done' (index + 1) bs'
365− js <- binderToJs elVar done'' binder
366− return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
367−
368−mainCall :: ModuleName -> String -> JS
369−mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []
src/Language/PureScript/CodeGen/JS/AST.hsdeleted−343
@@ -1,343 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.AST
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Data types for the intermediate simplified-Javascript AST
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DeriveDataTypeable #-}
17−
18−module Language.PureScript.CodeGen.JS.AST where
19−
20−import Control.Applicative (Applicative, (<$>), (<*>))
21−import Control.Monad.Identity
22−import Data.Data
23−import Data.Traversable (traverse)
24−
25−import Language.PureScript.Comments
26−
27−-- |
28−-- Built-in unary operators
29−--
30−data UnaryOperator
31− -- |
32− -- Numeric negation
33− --
34− = Negate
35− -- |
36− -- Boolean negation
37− --
38− | Not
39− -- |
40− -- Bitwise negation
41− --
42− | BitwiseNot
43− -- |
44− -- Numeric unary \'plus\'
45− --
46− | Positive
47− -- |
48− -- Constructor
49− --
50− | JSNew deriving (Show, Eq, Data, Typeable)
51−
52−-- |
53−-- Built-in binary operators
54−--
55−data BinaryOperator
56− -- |
57− -- Numeric addition
58− --
59− = Add
60− -- |
61− -- Numeric subtraction
62− --
63− | Subtract
64− -- |
65− -- Numeric multiplication
66− --
67− | Multiply
68− -- |
69− -- Numeric division
70− --
71− | Divide
72− -- |
73− -- Remainder
74− --
75− | Modulus
76− -- |
77− -- Generic equality test
78− --
79− | EqualTo
80− -- |
81− -- Generic inequality test
82− --
83− | NotEqualTo
84− -- |
85− -- Numeric less-than
86− --
87− | LessThan
88− -- |
89− -- Numeric less-than-or-equal
90− --
91− | LessThanOrEqualTo
92− -- |
93− -- Numeric greater-than
94− --
95− | GreaterThan
96− -- |
97− -- Numeric greater-than-or-equal
98− --
99− | GreaterThanOrEqualTo
100− -- |
101− -- Boolean and
102− --
103− | And
104− -- |
105− -- Boolean or
106− --
107− | Or
108− -- |
109− -- Bitwise and
110− --
111− | BitwiseAnd
112− -- |
113− -- Bitwise or
114− --
115− | BitwiseOr
116− -- |
117− -- Bitwise xor
118− --
119− | BitwiseXor
120− -- |
121− -- Bitwise left shift
122− --
123− | ShiftLeft
124− -- |
125− -- Bitwise right shift
126− --
127− | ShiftRight
128− -- |
129− -- Bitwise right shift with zero-fill
130− --
131− | ZeroFillShiftRight deriving (Show, Eq, Data, Typeable)
132−
133−-- |
134−-- Data type for simplified Javascript expressions
135−--
136−data JS
137− -- |
138− -- A numeric literal
139− --
140− = JSNumericLiteral (Either Integer Double)
141− -- |
142− -- A string literal
143− --
144− | JSStringLiteral String
145− -- |
146− -- A boolean literal
147− --
148− | JSBooleanLiteral Bool
149− -- |
150− -- A unary operator application
151− --
152− | JSUnary UnaryOperator JS
153− -- |
154− -- A binary operator application
155− --
156− | JSBinary BinaryOperator JS JS
157− -- |
158− -- An array literal
159− --
160− | JSArrayLiteral [JS]
161− -- |
162− -- An array indexer expression
163− --
164− | JSIndexer JS JS
165− -- |
166− -- An object literal
167− --
168− | JSObjectLiteral [(String, JS)]
169− -- |
170− -- An object property accessor expression
171− --
172− | JSAccessor String JS
173− -- |
174− -- A function introduction (optional name, arguments, body)
175− --
176− | JSFunction (Maybe String) [String] JS
177− -- |
178− -- Function application
179− --
180− | JSApp JS [JS]
181− -- |
182− -- Variable
183− --
184− | JSVar String
185− -- |
186− -- Conditional expression
187− --
188− | JSConditional JS JS JS
189− -- |
190− -- A block of expressions in braces
191− --
192− | JSBlock [JS]
193− -- |
194− -- A variable introduction and optional initialization
195− --
196− | JSVariableIntroduction String (Maybe JS)
197− -- |
198− -- A variable assignment
199− --
200− | JSAssignment JS JS
201− -- |
202− -- While loop
203− --
204− | JSWhile JS JS
205− -- |
206− -- For loop
207− --
208− | JSFor String JS JS JS
209− -- |
210− -- ForIn loop
211− --
212− | JSForIn String JS JS
213− -- |
214− -- If-then-else statement
215− --
216− | JSIfElse JS JS (Maybe JS)
217− -- |
218− -- Return statement
219− --
220− | JSReturn JS
221− -- |
222− -- Throw statement
223− --
224− | JSThrow JS
225− -- |
226− -- Type-Of operator
227− --
228− | JSTypeOf JS
229− -- |
230− -- InstanceOf test
231− --
232− | JSInstanceOf JS JS
233− -- |
234− -- Labelled statement
235− --
236− | JSLabel String JS
237− -- |
238− -- Break statement
239− --
240− | JSBreak String
241− -- |
242− -- Continue statement
243− --
244− | JSContinue String
245− -- |
246− -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)
247− --
248− | JSRaw String
249− -- |
250− -- Commented Javascript
251− --
252− | JSComment [Comment] JS deriving (Show, Eq, Data, Typeable)
253−
254−--
255−-- Traversals
256−--
257−
258−everywhereOnJS :: (JS -> JS) -> JS -> JS
259−everywhereOnJS f = go
260− where
261− go :: JS -> JS
262− go (JSUnary op j) = f (JSUnary op (go j))
263− go (JSBinary op j1 j2) = f (JSBinary op (go j1) (go j2))
264− go (JSArrayLiteral js) = f (JSArrayLiteral (map go js))
265− go (JSIndexer j1 j2) = f (JSIndexer (go j1) (go j2))
266− go (JSObjectLiteral js) = f (JSObjectLiteral (map (fmap go) js))
267− go (JSAccessor prop j) = f (JSAccessor prop (go j))
268− go (JSFunction name args j) = f (JSFunction name args (go j))
269− go (JSApp j js) = f (JSApp (go j) (map go js))
270− go (JSConditional j1 j2 j3) = f (JSConditional (go j1) (go j2) (go j3))
271− go (JSBlock js) = f (JSBlock (map go js))
272− go (JSVariableIntroduction name j) = f (JSVariableIntroduction name (fmap go j))
273− go (JSAssignment j1 j2) = f (JSAssignment (go j1) (go j2))
274− go (JSWhile j1 j2) = f (JSWhile (go j1) (go j2))
275− go (JSFor name j1 j2 j3) = f (JSFor name (go j1) (go j2) (go j3))
276− go (JSForIn name j1 j2) = f (JSForIn name (go j1) (go j2))
277− go (JSIfElse j1 j2 j3) = f (JSIfElse (go j1) (go j2) (fmap go j3))
278− go (JSReturn js) = f (JSReturn (go js))
279− go (JSThrow js) = f (JSThrow (go js))
280− go (JSTypeOf js) = f (JSTypeOf (go js))
281− go (JSLabel name js) = f (JSLabel name (go js))
282− go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))
283− go (JSComment com j) = f (JSComment com (go j))
284− go other = f other
285−
286−everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
287−everywhereOnJSTopDown f = runIdentity . everywhereOnJSTopDownM (Identity . f)
288−
289−everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS
290−everywhereOnJSTopDownM f = f >=> go
291− where
292− f' = f >=> go
293− go (JSUnary op j) = JSUnary op <$> f' j
294− go (JSBinary op j1 j2) = JSBinary op <$> f' j1 <*> f' j2
295− go (JSArrayLiteral js) = JSArrayLiteral <$> traverse f' js
296− go (JSIndexer j1 j2) = JSIndexer <$> f' j1 <*> f' j2
297− go (JSObjectLiteral js) = JSObjectLiteral <$> traverse (traverse f') js
298− go (JSAccessor prop j) = JSAccessor prop <$> f' j
299− go (JSFunction name args j) = JSFunction name args <$> f' j
300− go (JSApp j js) = JSApp <$> f' j <*> traverse f' js
301− go (JSConditional j1 j2 j3) = JSConditional <$> f' j1 <*> f' j2 <*> f' j3
302− go (JSBlock js) = JSBlock <$> traverse f' js
303− go (JSVariableIntroduction name j) = JSVariableIntroduction name <$> traverse f' j
304− go (JSAssignment j1 j2) = JSAssignment <$> f' j1 <*> f' j2
305− go (JSWhile j1 j2) = JSWhile <$> f' j1 <*> f' j2
306− go (JSFor name j1 j2 j3) = JSFor name <$> f' j1 <*> f' j2 <*> f' j3
307− go (JSForIn name j1 j2) = JSForIn name <$> f' j1 <*> f' j2
308− go (JSIfElse j1 j2 j3) = JSIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
309− go (JSReturn j) = JSReturn <$> f' j
310− go (JSThrow j) = JSThrow <$> f' j
311− go (JSTypeOf j) = JSTypeOf <$> f' j
312− go (JSLabel name j) = JSLabel name <$> f' j
313− go (JSInstanceOf j1 j2) = JSInstanceOf <$> f' j1 <*> f' j2
314− go (JSComment com j) = JSComment com <$> f' j
315− go other = f other
316−
317−everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
318−everythingOnJS (<>) f = go
319− where
320− go j@(JSUnary _ j1) = f j <> go j1
321− go j@(JSBinary _ j1 j2) = f j <> go j1 <> go j2
322− go j@(JSArrayLiteral js) = foldl (<>) (f j) (map go js)
323− go j@(JSIndexer j1 j2) = f j <> go j1 <> go j2
324− go j@(JSObjectLiteral js) = foldl (<>) (f j) (map (go . snd) js)
325− go j@(JSAccessor _ j1) = f j <> go j1
326− go j@(JSFunction _ _ j1) = f j <> go j1
327− go j@(JSApp j1 js) = foldl (<>) (f j <> go j1) (map go js)
328− go j@(JSConditional j1 j2 j3) = f j <> go j1 <> go j2 <> go j3
329− go j@(JSBlock js) = foldl (<>) (f j) (map go js)
330− go j@(JSVariableIntroduction _ (Just j1)) = f j <> go j1
331− go j@(JSAssignment j1 j2) = f j <> go j1 <> go j2
332− go j@(JSWhile j1 j2) = f j <> go j1 <> go j2
333− go j@(JSFor _ j1 j2 j3) = f j <> go j1 <> go j2 <> go j3
334− go j@(JSForIn _ j1 j2) = f j <> go j1 <> go j2
335− go j@(JSIfElse j1 j2 Nothing) = f j <> go j1 <> go j2
336− go j@(JSIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3
337− go j@(JSReturn j1) = f j <> go j1
338− go j@(JSThrow j1) = f j <> go j1
339− go j@(JSTypeOf j1) = f j <> go j1
340− go j@(JSLabel _ j1) = f j <> go j1
341− go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2
342− go j@(JSComment _ j1) = f j <> go j1
343− go other = f other
src/Language/PureScript/CodeGen/JS/Common.hsdeleted−181
@@ -1,181 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Common
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Common code generation utility functions
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Common where
17−
18−import Data.Char
19−import Data.List (intercalate)
20−
21−import Language.PureScript.Names
22−
23−-- |
24−-- Convert an Ident into a valid Javascript identifier:
25−--
26−-- * Alphanumeric characters are kept unmodified.
27−--
28−-- * Reserved javascript identifiers are prefixed with '$$'.
29−--
30−-- * Symbols are prefixed with '$' followed by a symbol name or their ordinal value.
31−--
32−identToJs :: Ident -> String
33−identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name
34−identToJs (Ident name) = concatMap identCharToString name
35−identToJs (Op op) = concatMap identCharToString op
36−
37−-- |
38−-- Test if a string is a valid JS identifier without escaping.
39−--
40−identNeedsEscaping :: String -> Bool
41−identNeedsEscaping s = s /= identToJs (Ident s)
42−
43−-- |
44−-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
45−-- ordinal value.
46−--
47−identCharToString :: Char -> String
48−identCharToString c | isAlphaNum c = [c]
49−identCharToString '_' = "_"
50−identCharToString '.' = "$dot"
51−identCharToString '$' = "$dollar"
52−identCharToString '~' = "$tilde"
53−identCharToString '=' = "$eq"
54−identCharToString '<' = "$less"
55−identCharToString '>' = "$greater"
56−identCharToString '!' = "$bang"
57−identCharToString '#' = "$hash"
58−identCharToString '%' = "$percent"
59−identCharToString '^' = "$up"
60−identCharToString '&' = "$amp"
61−identCharToString '|' = "$bar"
62−identCharToString '*' = "$times"
63−identCharToString '/' = "$div"
64−identCharToString '+' = "$plus"
65−identCharToString '-' = "$minus"
66−identCharToString ':' = "$colon"
67−identCharToString '\\' = "$bslash"
68−identCharToString '?' = "$qmark"
69−identCharToString '@' = "$at"
70−identCharToString '\'' = "$prime"
71−identCharToString c = '$' : show (ord c)
72−
73−-- |
74−-- Checks whether an identifier name is reserved in Javascript.
75−--
76−nameIsJsReserved :: String -> Bool
77−nameIsJsReserved name =
78− name `elem` [ "abstract"
79− , "arguments"
80− , "boolean"
81− , "break"
82− , "byte"
83− , "case"
84− , "catch"
85− , "char"
86− , "class"
87− , "const"
88− , "continue"
89− , "debugger"
90− , "default"
91− , "delete"
92− , "do"
93− , "double"
94− , "else"
95− , "enum"
96− , "eval"
97− , "export"
98− , "extends"
99− , "final"
100− , "finally"
101− , "float"
102− , "for"
103− , "function"
104− , "goto"
105− , "if"
106− , "implements"
107− , "import"
108− , "in"
109− , "instanceof"
110− , "int"
111− , "interface"
112− , "let"
113− , "long"
114− , "native"
115− , "new"
116− , "null"
117− , "package"
118− , "private"
119− , "protected"
120− , "public"
121− , "return"
122− , "short"
123− , "static"
124− , "super"
125− , "switch"
126− , "synchronized"
127− , "this"
128− , "throw"
129− , "throws"
130− , "transient"
131− , "try"
132− , "typeof"
133− , "var"
134− , "void"
135− , "volatile"
136− , "while"
137− , "with"
138− , "yield" ] || properNameIsJsReserved name
139−
140−moduleNameToJs :: ModuleName -> String
141−moduleNameToJs (ModuleName pns) =
142− let name = intercalate "_" (runProperName `map` pns)
143− in if properNameIsJsReserved name then "$$" ++ name else name
144−
145−-- |
146−-- Checks whether a proper name is reserved in Javascript.
147−--
148−properNameIsJsReserved :: String -> Bool
149−properNameIsJsReserved name =
150− name `elem` [ "Infinity"
151− , "NaN"
152− , "Object"
153− , "Function"
154− , "Boolean"
155− , "Error"
156− , "EvalError"
157− , "InternalError"
158− , "RangeError"
159− , "ReferenceError"
160− , "SyntaxError"
161− , "TypeError"
162− , "URIError"
163− , "Number"
164− , "Math"
165− , "Date"
166− , "String"
167− , "RegExp"
168− , "Array"
169− , "Int8Array"
170− , "Uint8Array"
171− , "Uint8ClampedArray"
172− , "Int16Array"
173− , "Uint16Array"
174− , "Int32Array"
175− , "Uint32Array"
176− , "Float32Array"
177− , "Float64Array"
178− , "ArrayBuffer"
179− , "DataView"
180− , "JSON"
181− , "Intl" ]
src/Language/PureScript/CodeGen/JS/Optimizer.hsdeleted−89
@@ -1,89 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module optimizes code in the simplified-Javascript intermediate representation.
13−--
14−-- The following optimizations are supported:
15−--
16−-- * Collapsing nested blocks
17−--
18−-- * Tail call elimination
19−--
20−-- * Inlining of (>>=) and ret for the Eff monad
21−--
22−-- * Removal of unnecessary thunks
23−--
24−-- * Eta conversion
25−--
26−-- * Inlining variables
27−--
28−-- * Inline Prelude.($), Prelude.(#), Prelude.(++), Prelude.(!!)
29−--
30−-- * Inlining primitive Javascript operators
31−--
32−-----------------------------------------------------------------------------
33−
34−{-# LANGUAGE FlexibleContexts #-}
35−
36−module Language.PureScript.CodeGen.JS.Optimizer (
37− optimize
38−) where
39−
40−import Control.Applicative (Applicative)
41−import Control.Monad.Reader (MonadReader, ask, asks)
42−import Control.Monad.Supply.Class (MonadSupply)
43−
44−import Language.PureScript.CodeGen.JS.AST
45−import Language.PureScript.Options
46−import qualified Language.PureScript.Constants as C
47−
48−import Language.PureScript.CodeGen.JS.Optimizer.Common
49−import Language.PureScript.CodeGen.JS.Optimizer.TCO
50−import Language.PureScript.CodeGen.JS.Optimizer.MagicDo
51−import Language.PureScript.CodeGen.JS.Optimizer.Inliner
52−import Language.PureScript.CodeGen.JS.Optimizer.Unused
53−import Language.PureScript.CodeGen.JS.Optimizer.Blocks
54−
55−-- |
56−-- Apply a series of optimizer passes to simplified Javascript code
57−--
58−optimize :: (Monad m, MonadReader (Options mode) m, Applicative m, MonadSupply m) => JS -> m JS
59−optimize js = do
60− noOpt <- asks optionsNoOptimizations
61− if noOpt then return js else optimize' js
62−
63−optimize' :: (Monad m, MonadReader (Options mode) m, Applicative m, MonadSupply m) => JS -> m JS
64−optimize' js = do
65− opts <- ask
66− untilFixedPoint (inlineArrComposition . applyAll
67− [ collapseNestedBlocks
68− , collapseNestedIfs
69− , tco opts
70− , magicDo opts
71− , removeCodeAfterReturnStatements
72− , removeUnusedArg
73− , removeUndefinedApp
74− , unThunk
75− , etaConvert
76− , evaluateIifes
77− , inlineVariables
78− , inlineValues
79− , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
80− , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
81− , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer
82− , inlineCommonOperators ]) js
83−
84−untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
85−untilFixedPoint f = go
86− where
87− go a = do
88− a' <- f a
89− if a' == a then return a' else go a'
src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hsdeleted−42
@@ -1,42 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Blocks
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Optimizer steps for simplifying Javascript blocks
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Blocks
17− ( collapseNestedBlocks
18− , collapseNestedIfs
19− ) where
20−
21−import Language.PureScript.CodeGen.JS.AST
22−
23−-- |
24−-- Collapse blocks which appear nested directly below another block
25−--
26−collapseNestedBlocks :: JS -> JS
27−collapseNestedBlocks = everywhereOnJS collapse
28− where
29− collapse :: JS -> JS
30− collapse (JSBlock sts) = JSBlock (concatMap go sts)
31− collapse js = js
32− go :: JS -> [JS]
33− go (JSBlock sts) = sts
34− go s = [s]
35−
36−collapseNestedIfs :: JS -> JS
37−collapseNestedIfs = everywhereOnJS collapse
38− where
39− collapse :: JS -> JS
40− collapse (JSIfElse cond1 (JSBlock [JSIfElse cond2 body Nothing]) Nothing) =
41− JSIfElse (JSBinary And cond1 cond2) body Nothing
42− collapse js = js
src/Language/PureScript/CodeGen/JS/Optimizer/Common.hsdeleted−77
@@ -1,77 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Common
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Common functions used by the various optimizer phases
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Common where
17−
18−import Data.Maybe (fromMaybe)
19−
20−import Language.PureScript.CodeGen.JS.AST
21−
22−applyAll :: [a -> a] -> a -> a
23−applyAll = foldl1 (.)
24−
25−replaceIdent :: String -> JS -> JS -> JS
26−replaceIdent var1 js = everywhereOnJS replace
27− where
28− replace (JSVar var2) | var1 == var2 = js
29− replace other = other
30−
31−replaceIdents :: [(String, JS)] -> JS -> JS
32−replaceIdents vars = everywhereOnJS replace
33− where
34− replace v@(JSVar var) = fromMaybe v $ lookup var vars
35− replace other = other
36−
37−isReassigned :: String -> JS -> Bool
38−isReassigned var1 = everythingOnJS (||) check
39− where
40− check :: JS -> Bool
41− check (JSFunction _ args _) | var1 `elem` args = True
42− check (JSVariableIntroduction arg _) | var1 == arg = True
43− check (JSAssignment (JSVar arg) _) | var1 == arg = True
44− check (JSFor arg _ _ _) | var1 == arg = True
45− check (JSForIn arg _ _) | var1 == arg = True
46− check _ = False
47−
48−isRebound :: JS -> JS -> Bool
49−isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnJS (++) variablesOf js)
50− where
51− variablesOf (JSVar var) = [var]
52− variablesOf _ = []
53−
54−isUsed :: String -> JS -> Bool
55−isUsed var1 = everythingOnJS (||) check
56− where
57− check :: JS -> Bool
58− check (JSVar var2) | var1 == var2 = True
59− check (JSAssignment target _) | var1 == targetVariable target = True
60− check _ = False
61−
62−targetVariable :: JS -> String
63−targetVariable (JSVar var) = var
64−targetVariable (JSAccessor _ tgt) = targetVariable tgt
65−targetVariable (JSIndexer _ tgt) = targetVariable tgt
66−targetVariable _ = error "Invalid argument to targetVariable"
67−
68−isUpdated :: String -> JS -> Bool
69−isUpdated var1 = everythingOnJS (||) check
70− where
71− check :: JS -> Bool
72− check (JSAssignment target _) | var1 == targetVariable target = True
73− check _ = False
74−
75−removeFromBlock :: ([JS] -> [JS]) -> JS -> JS
76−removeFromBlock go (JSBlock sts) = JSBlock (go sts)
77−removeFromBlock _ js = js
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hsdeleted−319
@@ -1,319 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Inliner
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module provides basic inlining capabilities
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
17− inlineVariables,
18− inlineValues,
19− inlineOperator,
20− inlineCommonOperators,
21− inlineArrComposition,
22− etaConvert,
23− unThunk,
24− evaluateIifes
25−) where
26−
27−import Control.Applicative (Applicative)
28−import Control.Monad.Supply.Class (MonadSupply, freshName)
29−import Data.Maybe (fromMaybe)
30−
31−import Language.PureScript.CodeGen.JS.AST
32−import Language.PureScript.CodeGen.JS.Common
33−import Language.PureScript.Names
34−import Language.PureScript.CodeGen.JS.Optimizer.Common
35−import qualified Language.PureScript.Constants as C
36−
37−-- TODO: Potential bug:
38−-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
39−-- Needs to be: { 0..toFixed(10); }
40−-- Probably needs to be fixed in pretty-printer instead.
41−shouldInline :: JS -> Bool
42−shouldInline (JSVar _) = True
43−shouldInline (JSNumericLiteral _) = True
44−shouldInline (JSStringLiteral _) = True
45−shouldInline (JSBooleanLiteral _) = True
46−shouldInline (JSAccessor _ val) = shouldInline val
47−shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
48−shouldInline _ = False
49−
50−etaConvert :: JS -> JS
51−etaConvert = everywhereOnJS convert
52− where
53− convert :: JS -> JS
54− convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
55− | all shouldInline args &&
56− not (any (`isRebound` block) (map JSVar idents)) &&
57− not (any (`isRebound` block) args)
58− = JSBlock (map (replaceIdents (zip idents args)) body)
59− convert (JSFunction Nothing [] (JSBlock [JSReturn (JSApp fn [])])) = fn
60− convert js = js
61−
62−unThunk :: JS -> JS
63−unThunk = everywhereOnJS convert
64− where
65− convert :: JS -> JS
66− convert (JSBlock []) = JSBlock []
67− convert (JSBlock jss) =
68− case last jss of
69− JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
70− _ -> JSBlock jss
71− convert js = js
72−
73−evaluateIifes :: JS -> JS
74−evaluateIifes = everywhereOnJS convert
75− where
76− convert :: JS -> JS
77− convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret
78− convert js = js
79−
80−inlineVariables :: JS -> JS
81−inlineVariables = everywhereOnJS $ removeFromBlock go
82− where
83− go :: [JS] -> [JS]
84− go [] = []
85− go (JSVariableIntroduction var (Just js) : sts)
86− | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
87− go (map (replaceIdent var js) sts)
88− go (s:sts) = s : go sts
89−
90−inlineValues :: JS -> JS
91−inlineValues = everywhereOnJS convert
92− where
93− convert :: JS -> JS
94− convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
95− | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
96− | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
97− | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
98− | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
99− | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
100− convert (JSApp fn [value]) | isFn fromNumber fn = JSBinary BitwiseOr value (JSNumericLiteral (Left 0))
101− convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
102− | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))
103− | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))
104− | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))
105− | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))
106− convert other = other
107− fnZero = (C.prelude, C.zero)
108− fnOne = (C.prelude, C.one)
109− fnBottom = (C.prelude, C.bottom)
110− fnTop = (C.prelude, C.top)
111− fromNumber = (C.dataInt, C.fromNumber)
112− fnAdd = (C.prelude, (C.+))
113− fnDivide = (C.prelude, (C./))
114− fnMultiply = (C.prelude, (C.*))
115− fnSubtract = (C.prelude, (C.-))
116−
117−inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
118−inlineOperator (m, op) f = everywhereOnJS convert
119− where
120− convert :: JS -> JS
121− convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y
122− convert other = other
123− isOp (JSAccessor longForm (JSVar m')) = m == m' && longForm == identToJs (Op op)
124− isOp (JSIndexer (JSStringLiteral op') (JSVar m')) = m == m' && op == op'
125− isOp _ = False
126−
127−inlineCommonOperators :: JS -> JS
128−inlineCommonOperators = applyAll $
129− [ binary semiringNumber (C.+) Add
130− , binary semiringNumber (C.*) Multiply
131−
132− , binary ringNumber (C.-) Subtract
133− , unary ringNumber C.negate Negate
134− , binary ringInt (C.-) Subtract
135− , unary ringInt C.negate Negate
136−
137− , binary moduloSemiringNumber (C./) Divide
138− , binary moduloSemiringInt C.mod Modulus
139−
140− , binary eqNumber (C.==) EqualTo
141− , binary eqNumber (C./=) NotEqualTo
142− , binary eqInt (C.==) EqualTo
143− , binary eqInt (C./=) NotEqualTo
144− , binary eqString (C.==) EqualTo
145− , binary eqString (C./=) NotEqualTo
146− , binary eqBoolean (C.==) EqualTo
147− , binary eqBoolean (C./=) NotEqualTo
148−
149− , binary ordNumber (C.<) LessThan
150− , binary ordNumber (C.>) GreaterThan
151− , binary ordNumber (C.<=) LessThanOrEqualTo
152− , binary ordNumber (C.>=) GreaterThanOrEqualTo
153− , binary ordInt (C.<) LessThan
154− , binary ordInt (C.>) GreaterThan
155− , binary ordInt (C.<=) LessThanOrEqualTo
156− , binary ordInt (C.>=) GreaterThanOrEqualTo
157−
158− , binary semigroupString (C.<>) Add
159− , binary semigroupString (C.++) Add
160−
161− , binary latticeBoolean (C.&&) And
162− , binary latticeBoolean (C.||) Or
163− , binaryFunction latticeBoolean C.inf And
164− , binaryFunction latticeBoolean C.sup Or
165− , unary complementedLatticeBoolean C.not Not
166−
167− , binary' C.dataIntBits (C..|.) BitwiseOr
168− , binary' C.dataIntBits (C..&.) BitwiseAnd
169− , binary' C.dataIntBits (C..^.) BitwiseXor
170− , binary' C.dataIntBits C.shl ShiftLeft
171− , binary' C.dataIntBits C.shr ShiftRight
172− , binary' C.dataIntBits C.zshr ZeroFillShiftRight
173− , unary' C.dataIntBits C.complement BitwiseNot
174− ] ++
175− [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
176− where
177− binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
178− binary dict opString op = everywhereOnJS convert
179− where
180− convert :: JS -> JS
181− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = JSBinary op x y
182− convert other = other
183− binary' :: String -> String -> BinaryOperator -> JS -> JS
184− binary' moduleName opString op = everywhereOnJS convert
185− where
186− convert :: JS -> JS
187− convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
188− convert other = other
189− binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS
190− binaryFunction dict fnName op = everywhereOnJS convert
191− where
192− convert :: JS -> JS
193− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = JSBinary op x y
194− convert other = other
195− unary :: (String, String) -> String -> UnaryOperator -> JS -> JS
196− unary dict fnName op = everywhereOnJS convert
197− where
198− convert :: JS -> JS
199− convert (JSApp (JSApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = JSUnary op x
200− convert other = other
201− unary' :: String -> String -> UnaryOperator -> JS -> JS
202− unary' moduleName fnName op = everywhereOnJS convert
203− where
204− convert :: JS -> JS
205− convert (JSApp fn [x]) | isFn (moduleName, fnName) fn = JSUnary op x
206− convert other = other
207− mkFn :: Int -> JS -> JS
208− mkFn 0 = everywhereOnJS convert
209− where
210− convert :: JS -> JS
211− convert (JSApp mkFnN [JSFunction Nothing [_] (JSBlock js)]) | isNFn C.mkFn 0 mkFnN =
212− JSFunction Nothing [] (JSBlock js)
213− convert other = other
214− mkFn n = everywhereOnJS convert
215− where
216− convert :: JS -> JS
217− convert orig@(JSApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
218− case collectArgs n [] fn of
219− Just (args, js) -> JSFunction Nothing args (JSBlock js)
220− Nothing -> orig
221− convert other = other
222− collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])
223− collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
224− collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
225− collectArgs _ _ _ = Nothing
226−
227− isNFn :: String -> Int -> JS -> Bool
228− isNFn prefix n (JSVar name) = name == (prefix ++ show n)
229− isNFn prefix n (JSAccessor name (JSVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
230− isNFn _ _ _ = False
231−
232− runFn :: Int -> JS -> JS
233− runFn n = everywhereOnJS convert
234− where
235− convert :: JS -> JS
236− convert js = fromMaybe js $ go n [] js
237−
238− go :: Int -> [JS] -> JS -> Maybe JS
239− go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
240− go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
241− go _ _ _ = Nothing
242−
243−-- (f <<< g $ x) = f (g x)
244−-- (f <<< g) = \x -> f (g x)
245−inlineArrComposition :: (Applicative m, MonadSupply m) => JS -> m JS
246−inlineArrComposition = everywhereOnJSTopDownM convert
247− where
248− convert :: (MonadSupply m) => JS -> m JS
249− convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isArrCompose dict' fn =
250− return $ JSApp x [JSApp y [z]]
251− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isArrCompose dict' fn = do
252− arg <- freshName
253− return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
254− convert other = return other
255− isArrCompose :: JS -> JS -> Bool
256− isArrCompose dict' fn = isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn
257−
258−isDict :: (String, String) -> JS -> Bool
259−isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
260−isDict _ _ = False
261−
262−isFn :: (String, String) -> JS -> Bool
263−isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
264−isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
265−isFn _ _ = False
266−
267−isPreludeFn :: String -> JS -> Bool
268−isPreludeFn fnName = isFn (C.prelude, fnName)
269−
270−semiringNumber :: (String, String)
271−semiringNumber = (C.prelude, C.semiringNumber)
272−
273−semiringInt :: (String, String)
274−semiringInt = (C.dataInt, C.semiringInt)
275−
276−ringNumber :: (String, String)
277−ringNumber = (C.prelude, C.ringNumber)
278−
279−ringInt :: (String, String)
280−ringInt = (C.dataInt, C.ringInt)
281−
282−moduloSemiringNumber :: (String, String)
283−moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
284−
285−moduloSemiringInt :: (String, String)
286−moduloSemiringInt = (C.dataInt, C.moduloSemiringInt)
287−
288−eqNumber :: (String, String)
289−eqNumber = (C.prelude, C.eqNumber)
290−
291−eqInt :: (String, String)
292−eqInt = (C.dataInt, C.eqInt)
293−
294−eqString :: (String, String)
295−eqString = (C.prelude, C.eqNumber)
296−
297−eqBoolean :: (String, String)
298−eqBoolean = (C.prelude, C.eqNumber)
299−
300−ordNumber :: (String, String)
301−ordNumber = (C.prelude, C.ordNumber)
302−
303−ordInt :: (String, String)
304−ordInt = (C.dataInt, C.ordInt)
305−
306−semigroupString :: (String, String)
307−semigroupString = (C.prelude, C.semigroupString)
308−
309−boundedBoolean :: (String, String)
310−boundedBoolean = (C.prelude, C.boundedBoolean)
311−
312−latticeBoolean :: (String, String)
313−latticeBoolean = (C.prelude, C.latticeBoolean)
314−
315−complementedLatticeBoolean :: (String, String)
316−complementedLatticeBoolean = (C.prelude, C.complementedLatticeBoolean)
317−
318−semigroupoidArr :: (String, String)
319−semigroupoidArr = (C.prelude, C.semigroupoidArr)
src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hsdeleted−165
@@ -1,165 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.MagicDo
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module implements the "Magic Do" optimization, which inlines calls to return
13−-- and bind for the Eff monad, as well as some of its actions.
14−--
15−-----------------------------------------------------------------------------
16−
17−module Language.PureScript.CodeGen.JS.Optimizer.MagicDo (
18− magicDo
19−) where
20−
21−import Data.List (nub)
22−import Data.Maybe (fromJust, isJust)
23−
24−import Language.PureScript.CodeGen.JS.AST
25−import Language.PureScript.CodeGen.JS.Common
26−import Language.PureScript.Names
27−import Language.PureScript.Options
28−import qualified Language.PureScript.Constants as C
29−
30−magicDo :: Options mode -> JS -> JS
31−magicDo opts | optionsNoMagicDo opts = id
32− | otherwise = inlineST . magicDo'
33−
34−-- |
35−-- Inline type class dictionaries for >>= and return for the Eff monad
36−--
37−-- E.g.
38−--
39−-- Prelude[">>="](dict)(m1)(function(x) {
40−-- return ...;
41−-- })
42−--
43−-- becomes
44−--
45−-- function __do {
46−-- var x = m1();
47−-- ...
48−-- }
49−--
50−magicDo' :: JS -> JS
51−magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
52− where
53− -- The name of the function block which is added to denote a do block
54− fnName = "__do"
55− -- Desugar monomorphic calls to >>= and return for the Eff monad
56− convert :: JS -> JS
57− -- Desugar return
58− convert (JSApp (JSApp ret [val]) []) | isReturn ret = val
59− -- Desugar pure
60− convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
61− -- Desugar >>
62− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind =
63− JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : map applyReturns js )
64− -- Desugar >>=
65− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind =
66− JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : map applyReturns js)
67− -- Desugar untilE
68− convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
69− JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []
70− -- Desugar whileE
71− convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
72− JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn $ JSObjectLiteral []])) []
73− convert other = other
74− -- Check if an expression represents a monomorphic call to >>= for the Eff monad
75− isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True
76− isBind _ = False
77− -- Check if an expression represents a monomorphic call to return for the Eff monad
78− isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True
79− isReturn _ = False
80− -- Check if an expression represents a monomorphic call to pure for the Eff applicative
81− isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
82− isPure _ = False
83− -- Check if an expression represents the polymorphic >>= function
84− isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))
85− isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)
86− isBindPoly _ = False
87− -- Check if an expression represents the polymorphic return function
88− isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
89− isRetPoly (JSIndexer (JSStringLiteral return') (JSVar prelude)) = prelude == C.prelude && return' == C.return
90− isRetPoly _ = False
91− -- Check if an expression represents the polymorphic pure function
92− isPurePoly (JSAccessor pure' (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
93− isPurePoly (JSIndexer (JSStringLiteral pure') (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
94− isPurePoly _ = False
95− -- Check if an expression represents a function in the Ef module
96− isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
97− isEffFunc _ _ = False
98− -- Check if an expression represents the Monad Eff dictionary
99− isEffDict name (JSVar ident) | ident == name = True
100− isEffDict name (JSAccessor prop (JSVar eff)) = eff == C.eff && prop == name
101− isEffDict _ _ = False
102− -- Remove __do function applications which remain after desugaring
103− undo :: JS -> JS
104− undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
105− undo other = other
106−
107− applyReturns :: JS -> JS
108− applyReturns (JSReturn ret) = JSReturn (JSApp ret [])
109− applyReturns (JSBlock jss) = JSBlock (map applyReturns jss)
110− applyReturns (JSWhile cond js) = JSWhile cond (applyReturns js)
111− applyReturns (JSFor v lo hi js) = JSFor v lo hi (applyReturns js)
112− applyReturns (JSForIn v xs js) = JSForIn v xs (applyReturns js)
113− applyReturns (JSIfElse cond t f) = JSIfElse cond (applyReturns t) (applyReturns `fmap` f)
114− applyReturns other = other
115−
116−-- |
117−-- Inline functions in the ST module
118−--
119−inlineST :: JS -> JS
120−inlineST = everywhereOnJS convertBlock
121− where
122− -- Look for runST blocks and inline the STRefs there.
123− -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
124− -- we can be more aggressive about inlining, and actually turn STRefs into local variables.
125− convertBlock (JSApp f [arg]) | isSTFunc C.runST f =
126− let refs = nub . findSTRefsIn $ arg
127− usages = findAllSTUsagesIn arg
128− allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
129− localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs
130− in everywhereOnJS (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg
131− convertBlock other = other
132− -- Convert a block in a safe way, preserving object wrappers of references,
133− -- or in a more aggressive way, turning wrappers into local variables depending on the
134− -- agg(ressive) parameter.
135− convert agg (JSApp f [arg]) | isSTFunc C.newSTRef f =
136− JSFunction Nothing [] (JSBlock [JSReturn $ if agg then arg else JSObjectLiteral [(C.stRefValue, arg)]])
137− convert agg (JSApp (JSApp f [ref]) []) | isSTFunc C.readSTRef f =
138− if agg then ref else JSAccessor C.stRefValue ref
139− convert agg (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =
140− if agg then JSAssignment ref arg else JSAssignment (JSAccessor C.stRefValue ref) arg
141− convert agg (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc C.modifySTRef f =
142− if agg then JSAssignment ref (JSApp func [ref]) else JSAssignment (JSAccessor C.stRefValue ref) (JSApp func [JSAccessor C.stRefValue ref])
143− convert _ other = other
144− -- Check if an expression represents a function in the ST module
145− isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'
146− isSTFunc _ _ = False
147− -- Find all ST Refs initialized in this block
148− findSTRefsIn = everythingOnJS (++) isSTRef
149− where
150− isSTRef (JSVariableIntroduction ident (Just (JSApp (JSApp f [_]) []))) | isSTFunc C.newSTRef f = [ident]
151− isSTRef _ = []
152− -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef
153− findAllSTUsagesIn = everythingOnJS (++) isSTUsage
154− where
155− isSTUsage (JSApp (JSApp f [ref]) []) | isSTFunc C.readSTRef f = [ref]
156− isSTUsage (JSApp (JSApp (JSApp f [ref]) [_]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]
157− isSTUsage _ = []
158− -- Find all uses of a variable
159− appearingIn ref = everythingOnJS (++) isVar
160− where
161− isVar e@(JSVar v) | v == ref = [e]
162− isVar _ = []
163− -- Convert a JS value to a String if it is a JSVar
164− toVar (JSVar v) = Just v
165− toVar _ = Nothing
src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hsdeleted−128
@@ -1,128 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.TCO
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module implements tail call elimination.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where
17−
18−import Data.Monoid
19−
20−import Language.PureScript.Options
21−import Language.PureScript.CodeGen.JS.AST
22−
23−-- |
24−-- Eliminate tail calls
25−--
26−tco :: Options mode -> JS -> JS
27−tco opts | optionsNoTco opts = id
28− | otherwise = tco'
29−
30−tco' :: JS -> JS
31−tco' = everywhereOnJS convert
32− where
33− tcoLabel :: String
34− tcoLabel = "tco"
35−
36− tcoVar :: String -> String
37− tcoVar arg = "__tco_" ++ arg
38−
39− copyVar :: String -> String
40− copyVar arg = "__copy_" ++ arg
41−
42− convert :: JS -> JS
43− convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
44− let
45− (argss, body', replace) = collectAllFunctionArgs [] id fn
46− in case () of
47− _ | isTailCall name body' ->
48− let
49− allArgs = concat $ reverse argss
50− in
51− JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
52− | otherwise -> js
53− convert js = js
54−
55− collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
56− collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
57− collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
58− collectAllFunctionArgs allArgs f (JSFunction ident args body@(JSBlock _)) =
59− (args : allArgs, body, f . JSFunction ident (map copyVar args))
60− collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args (JSBlock [body]))) =
61− collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction ident (map copyVar args) (JSBlock [b])))) body
62− collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
63− (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
64− collectAllFunctionArgs allArgs f body = (allArgs, body, f)
65−
66− isTailCall :: String -> JS -> Bool
67− isTailCall ident js =
68− let
69− numSelfCalls = everythingOnJS (+) countSelfCalls js
70− numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
71− numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
72− numSelfCallWithFnArgs = everythingOnJS (+) countSelfCallsWithFnArgs js
73− in
74− numSelfCalls > 0
75− && numSelfCalls == numSelfCallsInTailPosition
76− && numSelfCallsUnderFunctions == 0
77− && numSelfCallWithFnArgs == 0
78− where
79− countSelfCalls :: JS -> Int
80− countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
81− countSelfCalls _ = 0
82−
83− countSelfCallsInTailPosition :: JS -> Int
84− countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
85− countSelfCallsInTailPosition _ = 0
86−
87− countSelfCallsUnderFunctions :: JS -> Int
88− countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
89− countSelfCallsUnderFunctions _ = 0
90−
91− countSelfCallsWithFnArgs :: JS -> Int
92− countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0
93−
94− toLoop :: String -> [String] -> JS -> JS
95− toLoop ident allArgs js = JSBlock $
96− map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
97− [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhereOnJS loopify js ]) ]
98− where
99− loopify :: JS -> JS
100− loopify (JSReturn ret) | isSelfCall ident ret =
101− let
102− allArgumentValues = concat $ collectSelfCallArgs [] ret
103− in
104− JSBlock $ zipWith (\val arg ->
105− JSVariableIntroduction (tcoVar arg) (Just val)) allArgumentValues allArgs
106− ++ map (\arg ->
107− JSAssignment (JSVar arg) (JSVar (tcoVar arg))) allArgs
108− ++ [ JSContinue tcoLabel ]
109− loopify other = other
110− collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
111− collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
112− collectSelfCallArgs allArgumentValues _ = allArgumentValues
113−
114− isSelfCall :: String -> JS -> Bool
115− isSelfCall ident (JSApp (JSVar ident') _) = ident == ident'
116− isSelfCall ident (JSApp fn _) = isSelfCall ident fn
117− isSelfCall _ _ = False
118−
119− isSelfCallWithFnArgs :: String -> JS -> [JS] -> Bool
120− isSelfCallWithFnArgs ident (JSVar ident') args | ident == ident' && any hasFunction args = True
121− isSelfCallWithFnArgs ident (JSApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)
122− isSelfCallWithFnArgs _ _ _ = False
123−
124− hasFunction :: JS -> Bool
125− hasFunction = getAny . everythingOnJS mappend (Any . isFunction)
126− where
127− isFunction (JSFunction _ _ _) = True
128− isFunction _ = False
src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hsdeleted−46
@@ -1,46 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Unused
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Removes unused variables
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Unused
17− ( removeCodeAfterReturnStatements
18− , removeUnusedArg
19− , removeUndefinedApp
20− ) where
21−
22−import Language.PureScript.CodeGen.JS.AST
23−import Language.PureScript.CodeGen.JS.Optimizer.Common
24−
25−import qualified Language.PureScript.Constants as C
26−
27−removeCodeAfterReturnStatements :: JS -> JS
28−removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)
29− where
30− go :: [JS] -> [JS]
31− go jss | not (any isJSReturn jss) = jss
32− | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]
33− isJSReturn (JSReturn _) = True
34− isJSReturn _ = False
35−
36−removeUnusedArg :: JS -> JS
37−removeUnusedArg = everywhereOnJS convert
38− where
39− convert (JSFunction name [arg] body) | arg == C.__unused = JSFunction name [] body
40− convert js = js
41−
42−removeUndefinedApp :: JS -> JS
43−removeUndefinedApp = everywhereOnJS convert
44− where
45− convert (JSApp fn [JSVar arg]) | arg == C.undefined = JSApp fn []
46− convert js = js
src/Language/PureScript/Comments.hsdeleted−25
@@ -1,25 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser.Comments
4−-- Copyright : (c) Phil Freeman 2015
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Defines the types of source code comments
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DeriveDataTypeable #-}
17−
18−module Language.PureScript.Comments where
19−
20−import qualified Data.Data as D
21−
22−data Comment
23− = LineComment String
24− | BlockComment String
25− deriving (Show, Eq, Ord, D.Data, D.Typeable)
src/Language/PureScript/Constants.hsdeleted−281
@@ -1,281 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Constants
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Various constants which refer to things in the Prelude
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.Constants where
17−
18−-- Operators
19−
20−($) :: String
21−($) = "$"
22−
23−(#) :: String
24−(#) = "#"
25−
26−(<>) :: String
27−(<>) = "<>"
28−
29−(++) :: String
30−(++) = "++"
31−
32−(>>=) :: String
33−(>>=) = ">>="
34−
35−(+) :: String
36−(+) = "+"
37−
38−(-) :: String
39−(-) = "-"
40−
41−(*) :: String
42−(*) = "*"
43−
44−(/) :: String
45−(/) = "/"
46−
47−(%) :: String
48−(%) = "%"
49−
50−(<) :: String
51−(<) = "<"
52−
53−(>) :: String
54−(>) = ">"
55−
56−(<=) :: String
57−(<=) = "<="
58−
59−(>=) :: String
60−(>=) = ">="
61−
62−(==) :: String
63−(==) = "=="
64−
65−(/=) :: String
66−(/=) = "/="
67−
68−(&&) :: String
69−(&&) = "&&"
70−
71−(||) :: String
72−(||) = "||"
73−
74−unsafeIndex :: String
75−unsafeIndex = "unsafeIndex"
76−
77−(.|.) :: String
78−(.|.) = ".|."
79−
80−(.&.) :: String
81−(.&.) = ".&."
82−
83−(.^.) :: String
84−(.^.) = ".^."
85−
86−(<<<) :: String
87−(<<<) = "<<<"
88−
89−-- Functions
90−
91−negate :: String
92−negate = "negate"
93−
94−not :: String
95−not = "not"
96−
97−sup :: String
98−sup = "sup"
99−
100−inf :: String
101−inf = "inf"
102−
103−mod :: String
104−mod = "mod"
105−
106−shl :: String
107−shl = "shl"
108−
109−shr :: String
110−shr = "shr"
111−
112−zshr :: String
113−zshr = "zshr"
114−
115−complement :: String
116−complement = "complement"
117−
118−fromNumber :: String
119−fromNumber = "fromNumber"
120−
121−-- Prelude Values
122−
123−zero :: String
124−zero = "zero"
125−
126−one :: String
127−one = "one"
128−
129−bottom :: String
130−bottom = "bottom"
131−
132−top :: String
133−top = "top"
134−
135−return :: String
136−return = "return"
137−
138−pure' :: String
139−pure' = "pure"
140−
141−returnEscaped :: String
142−returnEscaped = "$return"
143−
144−untilE :: String
145−untilE = "untilE"
146−
147−whileE :: String
148−whileE = "whileE"
149−
150−runST :: String
151−runST = "runST"
152−
153−stRefValue :: String
154−stRefValue = "value"
155−
156−newSTRef :: String
157−newSTRef = "newSTRef"
158−
159−readSTRef :: String
160−readSTRef = "readSTRef"
161−
162−writeSTRef :: String
163−writeSTRef = "writeSTRef"
164−
165−modifySTRef :: String
166−modifySTRef = "modifySTRef"
167−
168−mkFn :: String
169−mkFn = "mkFn"
170−
171−runFn :: String
172−runFn = "runFn"
173−
174−unit :: String
175−unit = "unit"
176−
177−-- Prim values
178−
179−undefined :: String
180−undefined = "undefined"
181−
182−-- Type Class Dictionary Names
183−
184−monadEffDictionary :: String
185−monadEffDictionary = "monadEff"
186−
187−applicativeEffDictionary :: String
188−applicativeEffDictionary = "applicativeEff"
189−
190−bindEffDictionary :: String
191−bindEffDictionary = "bindEff"
192−
193−semiringNumber :: String
194−semiringNumber = "semiringNumber"
195−
196−semiringInt :: String
197−semiringInt = "semiringInt"
198−
199−ringNumber :: String
200−ringNumber = "ringNumber"
201−
202−ringInt :: String
203−ringInt = "ringInt"
204−
205−moduloSemiringNumber :: String
206−moduloSemiringNumber = "moduloSemiringNumber"
207−
208−moduloSemiringInt :: String
209−moduloSemiringInt = "moduloSemiringInt"
210−
211−ordNumber :: String
212−ordNumber = "ordNumber"
213−
214−ordInt :: String
215−ordInt = "ordInt"
216−
217−eqNumber :: String
218−eqNumber = "eqNumber"
219−
220−eqInt :: String
221−eqInt = "eqInt"
222−
223−eqString :: String
224−eqString = "eqString"
225−
226−eqBoolean :: String
227−eqBoolean = "eqBoolean"
228−
229−boundedBoolean :: String
230−boundedBoolean = "boundedBoolean"
231−
232−latticeBoolean :: String
233−latticeBoolean = "latticeBoolean"
234−
235−complementedLatticeBoolean :: String
236−complementedLatticeBoolean = "complementedLatticeBoolean"
237−
238−semigroupString :: String
239−semigroupString = "semigroupString"
240−
241−semigroupoidArr :: String
242−semigroupoidArr = "semigroupoidArr"
243−
244−-- Main module
245−
246−main :: String
247−main = "main"
248−
249−-- Code Generation
250−
251−__superclass_ :: String
252−__superclass_ = "__superclass_"
253−
254−__unused :: String
255−__unused = "__unused"
256−
257−-- Modules
258−
259−prim :: String
260−prim = "Prim"
261−
262−prelude :: String
263−prelude = "Prelude"
264−
265−dataArrayUnsafe :: String
266−dataArrayUnsafe = "Data_Array_Unsafe"
267−
268−eff :: String
269−eff = "Control_Monad_Eff"
270−
271−st :: String
272−st = "Control_Monad_ST"
273−
274−dataFunction :: String
275−dataFunction = "Data_Function"
276−
277−dataInt :: String
278−dataInt = "Data_Int"
279−
280−dataIntBits :: String
281−dataIntBits = "Data_Int_Bits"
src/Language/PureScript/CoreFn.hsdeleted−26
@@ -1,26 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The core functional representation
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.CoreFn (
16− module C
17−) where
18−
19−import Language.PureScript.CoreFn.Ann as C
20−import Language.PureScript.CoreFn.Binders as C
21−import Language.PureScript.CoreFn.Desugar as C
22−import Language.PureScript.CoreFn.Expr as C
23−import Language.PureScript.CoreFn.Literals as C
24−import Language.PureScript.CoreFn.Meta as C
25−import Language.PureScript.CoreFn.Module as C
26−import Language.PureScript.CoreFn.Traversals as C
src/Language/PureScript/CoreFn/Ann.hsdeleted−37
@@ -1,37 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Ann
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Type alias for basic annotations
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.CoreFn.Ann where
16−
17−import Language.PureScript.AST.SourcePos
18−import Language.PureScript.CoreFn.Meta
19−import Language.PureScript.Types
20−import Language.PureScript.Comments
21−
22−-- |
23−-- Type alias for basic annotations
24−--
25−type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)
26−
27−-- |
28−-- Initial annotation with no metadata
29−--
30−nullAnn :: Ann
31−nullAnn = (Nothing, [], Nothing, Nothing)
32−
33−-- |
34−-- Remove the comments from an annotation
35−--
36−removeComments :: Ann -> Ann
37−removeComments (ss, _, ty, meta) = (ss, [], ty, meta)
src/Language/PureScript/CoreFn/Binders.hsdeleted−48
@@ -1,48 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Binders
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The core functional representation for binders
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−{-# LANGUAGE DeriveFunctor #-}
17−
18−module Language.PureScript.CoreFn.Binders where
19−
20−import qualified Data.Data as D
21−
22−import Language.PureScript.CoreFn.Literals
23−import Language.PureScript.Names
24−
25−-- |
26−-- Data type for binders
27−--
28−data Binder a
29− -- |
30− -- Wildcard binder
31− --
32− = NullBinder a
33− -- |
34− -- A binder which matches a literal value
35− --
36− | LiteralBinder a (Literal (Binder a))
37− -- |
38− -- A binder which binds an identifier
39− --
40− | VarBinder a Ident
41− -- |
42− -- A binder which matches a data constructor (type name, constructor name, binders)
43− --
44− | ConstructorBinder a (Qualified ProperName) (Qualified ProperName) [Binder a]
45− -- |
46− -- A binder which binds its input to an identifier
47− --
48− | NamedBinder a Ident (Binder a) deriving (Show, D.Data, D.Typeable, Functor)
src/Language/PureScript/CoreFn/Desugar.hsdeleted−264
@@ -1,264 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Desugar
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The AST -> CoreFn desugaring step
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.CoreFn.Desugar (moduleToCoreFn) where
16−
17−import Data.Function (on)
18−import Data.List (sort, sortBy, nub)
19−import Data.Maybe (mapMaybe)
20−import qualified Data.Map as M
21−
22−import Control.Arrow (second, (***))
23−
24−import Language.PureScript.AST.SourcePos
25−import Language.PureScript.AST.Traversals
26−import Language.PureScript.CoreFn.Ann
27−import Language.PureScript.CoreFn.Binders
28−import Language.PureScript.CoreFn.Expr
29−import Language.PureScript.CoreFn.Literals
30−import Language.PureScript.CoreFn.Meta
31−import Language.PureScript.CoreFn.Module
32−import Language.PureScript.Environment
33−import Language.PureScript.Names
34−import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDictionaryNames)
35−import Language.PureScript.Types
36−import Language.PureScript.Comments
37−import qualified Language.PureScript.AST as A
38−
39−-- |
40−-- Desugars a module from AST to CoreFn representation.
41−--
42−moduleToCoreFn :: Environment -> A.Module -> Module Ann
43−moduleToCoreFn _ (A.Module _ _ _ Nothing) =
44− error "Module exports were not elaborated before moduleToCoreFn"
45−moduleToCoreFn env (A.Module coms mn decls (Just exps)) =
46− let imports = nub $ mapMaybe importToCoreFn decls ++ findQualModules decls
47− exps' = nub $ concatMap exportToCoreFn exps
48− externs = nub $ mapMaybe externToCoreFn decls
49− decls' = concatMap (declToCoreFn Nothing []) decls
50− in Module coms mn imports exps' externs decls'
51−
52− where
53−
54− -- |
55− -- Desugars member declarations from AST to CoreFn representation.
56− --
57− declToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Declaration -> [Bind Ann]
58− declToCoreFn ss com (A.DataDeclaration Newtype _ _ [(ctor, _)]) =
59− [NonRec (properToIdent ctor) $
60− Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var nullAnn $ Qualified Nothing (Ident "x"))]
61− declToCoreFn _ _ d@(A.DataDeclaration Newtype _ _ _) =
62− error $ "Found newtype with multiple constructors: " ++ show d
63− declToCoreFn ss com (A.DataDeclaration Data tyName _ ctors) =
64− flip map ctors $ \(ctor, _) ->
65− let (_, _, _, fields) = lookupConstructor env (Qualified (Just mn) ctor)
66− in NonRec (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields
67− declToCoreFn ss _ (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn ss []) ds
68− declToCoreFn ss com (A.ValueDeclaration name _ _ (Right e)) =
69− [NonRec name (exprToCoreFn ss com Nothing e)]
70− declToCoreFn ss _ (A.BindingGroupDeclaration ds) =
71− [Rec $ map (\(name, _, e) -> (name, exprToCoreFn ss [] Nothing e)) ds]
72− declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =
73− [NonRec (properToIdent name) $ mkTypeClassConstructor ss com supers members]
74− declToCoreFn _ com (A.PositionedDeclaration ss com1 d) =
75− declToCoreFn (Just ss) (com ++ com1) d
76− declToCoreFn _ _ _ = []
77−
78− -- |
79− -- Desugars expressions from AST to CoreFn representation.
80− --
81− exprToCoreFn :: Maybe SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann
82− exprToCoreFn ss com ty (A.NumericLiteral v) =
83− Literal (ss, com, ty, Nothing) (NumericLiteral v)
84− exprToCoreFn ss com ty (A.StringLiteral v) =
85− Literal (ss, com, ty, Nothing) (StringLiteral v)
86− exprToCoreFn ss com ty (A.CharLiteral v) =
87− Literal (ss, com, ty, Nothing) (CharLiteral v)
88− exprToCoreFn ss com ty (A.BooleanLiteral v) =
89− Literal (ss, com, ty, Nothing) (BooleanLiteral v)
90− exprToCoreFn ss com ty (A.ArrayLiteral vs) =
91− Literal (ss, com, ty, Nothing) (ArrayLiteral $ map (exprToCoreFn ss [] Nothing) vs)
92− exprToCoreFn ss com ty (A.ObjectLiteral vs) =
93− Literal (ss, com, ty, Nothing) (ObjectLiteral $ map (second (exprToCoreFn ss [] Nothing)) vs)
94− exprToCoreFn ss com ty (A.Accessor name v) =
95− Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
96− exprToCoreFn ss com ty (A.ObjectUpdate obj vs) =
97− ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ map (second (exprToCoreFn ss [] Nothing)) vs
98− exprToCoreFn ss com ty (A.Abs (Left name) v) =
99− Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
100− exprToCoreFn _ _ _ (A.Abs _ _) =
101− error "Abs with Binder argument was not desugared before exprToCoreFn mn"
102− exprToCoreFn ss com ty (A.App v1 v2) =
103− App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)
104− exprToCoreFn ss com ty (A.Var ident) =
105− Var (ss, com, ty, getValueMeta ident) ident
106− exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =
107− Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]
108− [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]
109− (Right $ exprToCoreFn Nothing [] Nothing v2)
110− , CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral False]
111− (Right $ exprToCoreFn Nothing [] Nothing v3) ]
112− exprToCoreFn ss com ty (A.Constructor name) =
113− Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name
114− exprToCoreFn ss com ty (A.Case vs alts) =
115− Case (ss, com, ty, Nothing) (map (exprToCoreFn ss [] Nothing) vs) (map (altToCoreFn ss) alts)
116− exprToCoreFn ss com _ (A.TypedValue _ v ty) =
117− exprToCoreFn ss com (Just ty) v
118− exprToCoreFn ss com ty (A.Let ds v) =
119− Let (ss, com, ty, Nothing) (concatMap (declToCoreFn ss []) ds) (exprToCoreFn ss [] Nothing v)
120− exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ (A.ObjectLiteral vs) _)) =
121− let args = map (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs
122− ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)
123− in foldl (App (ss, com, Nothing, Nothing)) ctor args
124− exprToCoreFn ss com ty (A.TypeClassDictionaryAccessor _ ident) =
125− Abs (ss, com, ty, Nothing) (Ident "dict")
126− (Accessor nullAnn (runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))
127− exprToCoreFn _ com ty (A.PositionedValue ss com1 v) =
128− exprToCoreFn (Just ss) (com ++ com1) ty v
129− exprToCoreFn _ _ _ e =
130− error $ "Unexpected value in exprToCoreFn mn: " ++ show e
131−
132− -- |
133− -- Desugars case alternatives from AST to CoreFn representation.
134− --
135− altToCoreFn :: Maybe SourceSpan -> A.CaseAlternative -> CaseAlternative Ann
136− altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn ss []) bs) (go vs)
137− where
138− go :: Either [(A.Guard, A.Expr)] A.Expr -> Either [(Guard Ann, Expr Ann)] (Expr Ann)
139− go (Left ges) = Left $ map (exprToCoreFn ss [] Nothing *** exprToCoreFn ss [] Nothing) ges
140− go (Right e) = Right (exprToCoreFn ss [] Nothing e)
141−
142− -- |
143− -- Desugars case binders from AST to CoreFn representation.
144− --
145− binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann
146− binderToCoreFn ss com (A.NullBinder) =
147− NullBinder (ss, com, Nothing, Nothing)
148− binderToCoreFn ss com (A.BooleanBinder b) =
149− LiteralBinder (ss, com, Nothing, Nothing) (BooleanLiteral b)
150− binderToCoreFn ss com (A.StringBinder s) =
151− LiteralBinder (ss, com, Nothing, Nothing) (StringLiteral s)
152− binderToCoreFn ss com (A.CharBinder c) =
153− LiteralBinder (ss, com, Nothing, Nothing) (CharLiteral c)
154− binderToCoreFn ss com (A.NumberBinder n) =
155− LiteralBinder (ss, com, Nothing, Nothing) (NumericLiteral n)
156− binderToCoreFn ss com (A.VarBinder name) =
157− VarBinder (ss, com, Nothing, Nothing) name
158− binderToCoreFn ss com (A.ConstructorBinder dctor@(Qualified mn' _) bs) =
159− let (_, tctor, _, _) = lookupConstructor env dctor
160− in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (map (binderToCoreFn ss []) bs)
161− binderToCoreFn ss com (A.ObjectBinder bs) =
162− LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn ss [])) bs)
163− binderToCoreFn ss com (A.ArrayBinder bs) =
164− LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn ss []) bs)
165− binderToCoreFn ss com (A.NamedBinder name b) =
166− NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)
167− binderToCoreFn _ com (A.PositionedBinder ss com1 b) =
168− binderToCoreFn (Just ss) (com ++ com1) b
169−
170− -- |
171− -- Gets metadata for values.
172− --
173− getValueMeta :: Qualified Ident -> Maybe Meta
174− getValueMeta name =
175− case lookupValue env name of
176− Just (_, External, _) -> Just IsForeign
177− _ -> Nothing
178−
179− -- |
180− -- Gets metadata for data constructors.
181− --
182− getConstructorMeta :: Qualified ProperName -> Meta
183− getConstructorMeta ctor =
184− case lookupConstructor env ctor of
185− (Newtype, _, _, _) -> IsNewtype
186− dc@(Data, _, _, fields) ->
187− let constructorType = if numConstructors (ctor, dc) == 1 then ProductType else SumType
188− in IsConstructor constructorType fields
189− where
190− numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> Int
191− numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors env
192− typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> (ModuleName, ProperName)
193− typeConstructor (Qualified (Just mn') _, (_, tyCtor, _, _)) = (mn', tyCtor)
194− typeConstructor _ = error "Invalid argument to typeConstructor"
195−
196−-- |
197−-- Find module names from qualified references to values. This is used to
198−-- ensure instances are imported from any module that is referenced by the
199−-- current module, not just from those that are imported explicitly (#667).
200−--
201−findQualModules :: [A.Declaration] -> [ModuleName]
202−findQualModules decls =
203− let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues fqBinders (const []) (const [])
204− in f `concatMap` decls
205− where
206− fqValues :: A.Expr -> [ModuleName]
207− fqValues (A.Var (Qualified (Just mn) _)) = [mn]
208− fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]
209− fqValues _ = []
210−
211− fqBinders :: A.Binder -> [ModuleName]
212− fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]
213− fqBinders _ = []
214−
215−-- |
216−-- Desugars import declarations from AST to CoreFn representation.
217−--
218−importToCoreFn :: A.Declaration -> Maybe ModuleName
219−importToCoreFn (A.ImportDeclaration name _ _) = Just name
220−importToCoreFn (A.PositionedDeclaration _ _ d) = importToCoreFn d
221−importToCoreFn _ = Nothing
222−
223−-- |
224−-- Desugars foreign declarations from AST to CoreFn representation.
225−--
226−externToCoreFn :: A.Declaration -> Maybe ForeignDecl
227−externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)
228−externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, tyObject)
229−externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d
230−externToCoreFn _ = Nothing
231−
232−-- |
233−-- Desugars export declarations references from AST to CoreFn representation.
234−-- CoreFn modules only export values, so all data constructors, class
235−-- constructor, instances and values are flattened into one list.
236−--
237−exportToCoreFn :: A.DeclarationRef -> [Ident]
238−exportToCoreFn (A.TypeRef _ (Just dctors)) = map properToIdent dctors
239−exportToCoreFn (A.ValueRef name) = [name]
240−exportToCoreFn (A.TypeClassRef name) = [properToIdent name]
241−exportToCoreFn (A.TypeInstanceRef name) = [name]
242−exportToCoreFn (A.PositionedDeclarationRef _ _ d) = exportToCoreFn d
243−exportToCoreFn _ = []
244−
245−-- |
246−-- Makes a typeclass dictionary constructor function. The returned expression
247−-- is a function that accepts the superclass instances and member
248−-- implementations and returns a record for the instance dictionary.
249−--
250−mkTypeClassConstructor :: Maybe SourceSpan -> [Comment] -> [Constraint] -> [A.Declaration] -> Expr Ann
251−mkTypeClassConstructor ss com [] [] = Literal (ss, com, Nothing, Just IsTypeClassConstructor) (ObjectLiteral [])
252−mkTypeClassConstructor ss com supers members =
253− let args@(a:as) = sort $ map typeClassMemberName members ++ superClassDictionaryNames supers
254− props = [ (arg, Var nullAnn $ Qualified Nothing (Ident arg)) | arg <- args ]
255− dict = Literal nullAnn (ObjectLiteral props)
256− in Abs (ss, com, Nothing, Just IsTypeClassConstructor)
257− (Ident a)
258− (foldr (Abs nullAnn . Ident) dict as)
259−
260−-- |
261−-- Converts a ProperName to an Ident.
262−--
263−properToIdent :: ProperName -> Ident
264−properToIdent = Ident . runProperName
src/Language/PureScript/CoreFn/Expr.hsdeleted−134
@@ -1,134 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Expr
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The core functional representation
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−{-# LANGUAGE DeriveFunctor #-}
17−
18−module Language.PureScript.CoreFn.Expr where
19−
20−import Control.Arrow ((***))
21−
22−import qualified Data.Data as D
23−
24−import Language.PureScript.CoreFn.Binders
25−import Language.PureScript.CoreFn.Literals
26−import Language.PureScript.Names
27−
28−-- |
29−-- Data type for expressions and terms
30−--
31−data Expr a
32− -- |
33− -- A literal value
34− --
35− = Literal a (Literal (Expr a))
36− -- |
37− -- A data constructor (type name, constructor name, field names)
38− --
39− | Constructor a ProperName ProperName [Ident]
40− -- |
41− -- A record property accessor
42− --
43− | Accessor a String (Expr a)
44− -- |
45− -- Partial record update
46− --
47− | ObjectUpdate a (Expr a) [(String, Expr a)]
48− -- |
49− -- Function introduction
50− --
51− | Abs a Ident (Expr a)
52− -- |
53− -- Function application
54− --
55− | App a (Expr a) (Expr a)
56− -- |
57− -- Variable
58− --
59− | Var a (Qualified Ident)
60− -- |
61− -- A case expression
62− --
63− | Case a [Expr a] [CaseAlternative a]
64− -- |
65− -- A let binding
66− --
67− | Let a [Bind a] (Expr a) deriving (Show, D.Data, D.Typeable, Functor)
68−
69−-- |
70−-- A let or module binding.
71−--
72−data Bind a
73− -- |
74− -- Non-recursive binding for a single value
75− --
76− = NonRec Ident (Expr a)
77− -- |
78− -- Mutually recursive binding group for several values
79− --
80− | Rec [(Ident, Expr a)] deriving (Show, D.Data, D.Typeable, Functor)
81−
82−-- |
83−-- A guard is just a boolean-valued expression that appears alongside a set of binders
84−--
85−type Guard a = Expr a
86−
87−-- |
88−-- An alternative in a case statement
89−--
90−data CaseAlternative a = CaseAlternative
91− { -- |
92− -- A collection of binders with which to match the inputs
93− --
94− caseAlternativeBinders :: [Binder a]
95− -- |
96− -- The result expression or a collect of guarded expressions
97− --
98− , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
99− } deriving (Show, D.Data, D.Typeable)
100−
101−instance Functor CaseAlternative where
102−
103− fmap f (CaseAlternative cabs car) = CaseAlternative
104− (fmap (fmap f) $ cabs)
105− (either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)
106−
107−-- |
108−-- Extract the annotation from a term
109−--
110−extractAnn :: Expr a -> a
111−extractAnn (Literal a _) = a
112−extractAnn (Constructor a _ _ _) = a
113−extractAnn (Accessor a _ _) = a
114−extractAnn (ObjectUpdate a _ _) = a
115−extractAnn (Abs a _ _) = a
116−extractAnn (App a _ _) = a
117−extractAnn (Var a _) = a
118−extractAnn (Case a _ _) = a
119−extractAnn (Let a _ _) = a
120−
121−
122−-- |
123−-- Modify the annotation on a term
124−--
125−modifyAnn :: (a -> a) -> Expr a -> Expr a
126−modifyAnn f (Literal a b) = Literal (f a) b
127−modifyAnn f (Constructor a b c d) = Constructor (f a) b c d
128−modifyAnn f (Accessor a b c) = Accessor (f a) b c
129−modifyAnn f (ObjectUpdate a b c) = ObjectUpdate (f a) b c
130−modifyAnn f (Abs a b c) = Abs (f a) b c
131−modifyAnn f (App a b c) = App (f a) b c
132−modifyAnn f (Var a b) = Var (f a) b
133−modifyAnn f (Case a b c) = Case (f a) b c
134−modifyAnn f (Let a b c) = Let (f a) b c
src/Language/PureScript/CoreFn/Literals.hsdeleted−50
@@ -1,50 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Literals
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The core functional representation for literal values.
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−{-# LANGUAGE DeriveFunctor #-}
17−
18−module Language.PureScript.CoreFn.Literals where
19−
20−import qualified Data.Data as D
21−
22−-- |
23−-- Data type for literal values. Parameterised so it can be used for Exprs and
24−-- Binders.
25−--
26−data Literal a
27− -- |
28− -- A numeric literal
29− --
30− = NumericLiteral (Either Integer Double)
31− -- |
32− -- A string literal
33− --
34− | StringLiteral String
35− -- |
36− -- A character literal
37− --
38− | CharLiteral Char
39− -- |
40− -- A boolean literal
41− --
42− | BooleanLiteral Bool
43− -- |
44− -- An array literal
45− --
46− | ArrayLiteral [a]
47− -- |
48− -- An object literal
49− --
50− | ObjectLiteral [(String, a)] deriving (Show, D.Data, D.Typeable, Functor)
src/Language/PureScript/CoreFn/Meta.hsdeleted−55
@@ -1,55 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Meta
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Metadata annotations for core functional representation
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−
17−module Language.PureScript.CoreFn.Meta where
18−
19−import qualified Data.Data as D
20−
21−import Language.PureScript.Names
22−
23−-- |
24−-- Metadata annotations
25−--
26−data Meta
27− -- |
28− -- The contained value is a data constructor
29− --
30− = IsConstructor ConstructorType [Ident]
31− -- |
32− -- The contained value is a newtype
33− --
34− | IsNewtype
35− -- |
36− -- The contained value is a typeclass dictionary constructor
37− --
38− | IsTypeClassConstructor
39− -- |
40− -- The contained reference is for a foreign member
41− --
42− | IsForeign deriving (Show, D.Data, D.Typeable)
43−
44−-- |
45−-- Data constructor metadata
46−--
47−data ConstructorType
48− -- |
49− -- The constructor is for a type with a single construcor
50− --
51− = ProductType
52− -- |
53− -- The constructor is for a type with multiple construcors
54− --
55− | SumType deriving (Show, D.Data, D.Typeable)
src/Language/PureScript/CoreFn/Module.hsdeleted−31
@@ -1,31 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Module
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The CoreFn module representation
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.CoreFn.Module where
16−
17−import Language.PureScript.Comments
18−import Language.PureScript.CoreFn.Expr
19−import Language.PureScript.Names
20−import Language.PureScript.Types
21−
22−data Module a = Module
23− { moduleComments :: [Comment]
24− , moduleName :: ModuleName
25− , moduleImports :: [ModuleName]
26− , moduleExports :: [Ident]
27− , moduleForeign :: [ForeignDecl]
28− , moduleDecls :: [Bind a]
29− } deriving (Show)
30−
31−type ForeignDecl = (Ident, Type)
src/Language/PureScript/CoreFn/Traversals.hsdeleted−85
@@ -1,85 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Traversals
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | CoreFn traversal helpers
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.CoreFn.Traversals where
16−
17−import Control.Arrow (second, (***), (+++))
18−
19−import Language.PureScript.CoreFn.Binders
20−import Language.PureScript.CoreFn.Expr
21−import Language.PureScript.CoreFn.Literals
22−
23−everywhereOnValues :: (Bind a -> Bind a) ->
24− (Expr a -> Expr a) ->
25− (Binder a -> Binder a) ->
26− (Bind a -> Bind a, Expr a -> Expr a, Binder a -> Binder a)
27−everywhereOnValues f g h = (f', g', h')
28− where
29− f' (NonRec name e) = f (NonRec name (g' e))
30− f' (Rec es) = f (Rec (map (second g') es))
31−
32− g' (Literal ann e) = g (Literal ann (handleLiteral g' e))
33− g' (Accessor ann prop e) = g (Accessor ann prop (g' e))
34− g' (ObjectUpdate ann obj vs) = g (ObjectUpdate ann (g' obj) (map (fmap g') vs))
35− g' (Abs ann name e) = g (Abs ann name (g' e))
36− g' (App ann v1 v2) = g (App ann (g' v1) (g' v2))
37− g' (Case ann vs alts) = g (Case ann (map g' vs) (map handleCaseAlternative alts))
38− g' (Let ann ds e) = g (Let ann (map f' ds) (g' e))
39− g' e = g e
40−
41− h' (LiteralBinder a b) = h (LiteralBinder a (handleLiteral h' b))
42− h' (NamedBinder a name b) = h (NamedBinder a name (h' b))
43− h' b = h b
44−
45− handleCaseAlternative ca =
46− ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
47− , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
48− }
49−
50− handleLiteral :: (a -> a) -> Literal a -> Literal a
51− handleLiteral i (ArrayLiteral ls) = ArrayLiteral (map i ls)
52− handleLiteral i (ObjectLiteral ls) = ObjectLiteral (map (fmap i) ls)
53− handleLiteral _ other = other
54−
55−everythingOnValues :: (r -> r -> r) ->
56− (Bind a -> r) ->
57− (Expr a -> r) ->
58− (Binder a -> r) ->
59− (CaseAlternative a -> r) ->
60− (Bind a -> r, Expr a -> r, Binder a -> r, CaseAlternative a -> r)
61−everythingOnValues (<>) f g h i = (f', g', h', i')
62− where
63− f' b@(NonRec _ e) = f b <> g' e
64− f' b@(Rec es) = foldl (<>) (f b) (map (g' . snd) es)
65−
66− g' v@(Literal _ l) = foldl (<>) (g v) (map g' (extractLiteral l))
67− g' v@(Accessor _ _ e1) = g v <> g' e1
68− g' v@(ObjectUpdate _ obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
69− g' v@(Abs _ _ e1) = g v <> g' e1
70− g' v@(App _ e1 e2) = g v <> g' e1 <> g' e2
71− g' v@(Case _ vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
72− g' v@(Let _ ds e1) = foldl (<>) (g v) (map f' ds) <> g' e1
73− g' v = g v
74−
75− h' b@(LiteralBinder _ l) = foldl (<>) (h b) (map h' (extractLiteral l))
76− h' b@(ConstructorBinder _ _ _ bs) = foldl (<>) (h b) (map h' bs)
77− h' b@(NamedBinder _ _ b1) = h b <> h' b1
78− h' b = h b
79−
80− i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
81− i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
82−
83− extractLiteral (ArrayLiteral xs) = xs
84− extractLiteral (ObjectLiteral xs) = map snd xs
85− extractLiteral _ = []
src/Language/PureScript/DeadCodeElimination.hsdeleted−102
@@ -1,102 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.DeadCodeElimination
4−-- Copyright : (c) 2014 Phil Freeman
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Dead code elimination.
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.DeadCodeElimination (
16− eliminateDeadCode
17−) where
18−
19−import Data.Graph
20−import Data.List
21−import Data.Maybe (mapMaybe)
22−
23−import Language.PureScript.CoreFn
24−import Language.PureScript.Names
25−
26−-- |
27−-- Eliminate all declarations which are not a transitive dependency of the entry point module
28−--
29−eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]
30−eliminateDeadCode entryPoints ms = map go ms
31− where
32− go (Module coms mn imps exps foreigns ds) = Module coms mn imps exps' foreigns' ds'
33− where
34− ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds
35− foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns
36− names = concatMap bindIdents ds' ++ map foreignIdent foreigns'
37− exps' = filter (`elem` names) exps
38− declarations = concatMap declarationsByModule ms
39− (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
40− entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
41−
42−-- |
43−-- Extract declaration names for a binding group.
44−--
45−bindIdents :: Bind a -> [Ident]
46−bindIdents (NonRec name _) = [name]
47−bindIdents (Rec names) = map fst names
48−
49−-- |
50−-- Extract the ident for a foreign declaration.
51−--
52−foreignIdent :: ForeignDecl -> Ident
53−foreignIdent = fst
54−
55−-- |
56−-- Key type to use in graph
57−--
58−type Key = (ModuleName, Ident)
59−
60−-- |
61−-- Find dependencies for each member in a module.
62−--
63−declarationsByModule :: Module a -> [(Key, [Key])]
64−declarationsByModule (Module _ mn _ _ fs ds) =
65− let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs
66− in fs' ++ concatMap go ds
67− where
68− go :: Bind a -> [(Key, [Key])]
69− go d@(NonRec name _) = [((mn, name), dependencies d)]
70− go d@(Rec names') = map (\(name, _) -> ((mn, name), dependencies d)) names'
71−
72−-- |
73−-- Find all referenced values within a binding group.
74−--
75−dependencies :: Bind a -> [Key]
76−dependencies =
77− let (f, _, _, _) = everythingOnValues (++) (const []) values binders (const [])
78− in nub . f
79− where
80− values :: Expr a -> [Key]
81− values (Var _ (Qualified (Just mn) ident)) = [(mn, ident)]
82− values _ = []
83− binders :: Binder a -> [Key]
84− binders (ConstructorBinder _ _ (Qualified (Just mn) ident) _) = [(mn, Ident $ runProperName ident)]
85− binders _ = []
86−
87−-- |
88−-- Check whether a binding group is used.
89−--
90−isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Bind a -> Bool
91−isUsed mn graph vertexFor entryPointVertices (NonRec name _) =
92− isUsed' mn graph vertexFor entryPointVertices name
93−isUsed mn graph vertexFor entryPointVertices (Rec ds) =
94− any (isUsed' mn graph vertexFor entryPointVertices . fst) ds
95−
96−-- |
97−-- Check whether a named declaration is used.
98−--
99−isUsed' :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Ident -> Bool
100−isUsed' mn graph vertexFor entryPointVertices name =
101− let Just v' = vertexFor (mn, name)
102− in any (\v -> path graph v v') entryPointVertices
src/Language/PureScript/Docs.hsdeleted−13
@@ -1,13 +0,0 @@
1−
2−-- | Data types and functions for rendering generated documentation from
3−-- PureScript code, in a variety of formats.
4−
5−module Language.PureScript.Docs (
6− module Docs
7−) where
8−
9−import Language.PureScript.Docs.Types as Docs
10−import Language.PureScript.Docs.RenderedCode.Types as Docs
11−import Language.PureScript.Docs.RenderedCode.Render as Docs
12−import Language.PureScript.Docs.Render as Docs
13−import Language.PureScript.Docs.ParseAndDesugar as Docs
src/Language/PureScript/Docs/AsMarkdown.hsdeleted−102
@@ -1,102 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−
3−module Language.PureScript.Docs.AsMarkdown (
4− renderModulesAsMarkdown
5−) where
6−
7−import Control.Monad.Writer hiding (First)
8−import Data.Foldable (for_)
9−import Data.List (partition)
10−
11−import qualified Language.PureScript as P
12−
13−import Language.PureScript.Docs.Types
14−import Language.PureScript.Docs.RenderedCode
15−import qualified Language.PureScript.Docs.Render as Render
16−
17−-- |
18−-- Take a list of modules and render them all in order, returning a single
19−-- Markdown-formatted String.
20−--
21−renderModulesAsMarkdown :: [P.Module] -> String
22−renderModulesAsMarkdown =
23− runDocs . modulesAsMarkdown . map Render.renderModule
24−
25−modulesAsMarkdown :: [RenderedModule] -> Docs
26−modulesAsMarkdown = mapM_ moduleAsMarkdown
27−
28−moduleAsMarkdown :: RenderedModule -> Docs
29−moduleAsMarkdown RenderedModule{..} = do
30− headerLevel 2 $ "Module " ++ rmName
31− spacer
32− for_ rmComments tell'
33− mapM_ declAsMarkdown rmDeclarations
34− spacer
35−
36−declAsMarkdown :: RenderedDeclaration -> Docs
37−declAsMarkdown RenderedDeclaration{..} = do
38− headerLevel 4 (ticks rdTitle)
39− spacer
40−
41− let (instances, children) = partition ((==) ChildInstance . rcdType) rdChildren
42− fencedBlock $ do
43− tell' (codeToString rdCode)
44− zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children
45− spacer
46−
47− unless (null instances) $ do
48− headerLevel 5 "Instances"
49− fencedBlock $ do
50− mapM_ (tell' . childToString NotFirst) instances
51− spacer
52−
53− for_ rdComments tell'
54−
55−codeToString :: RenderedCode -> String
56−codeToString = outputWith elemAsMarkdown
57− where
58− elemAsMarkdown (Syntax x) = x
59− elemAsMarkdown (Ident x) = x
60− elemAsMarkdown (Ctor x _) = x
61− elemAsMarkdown (Kind x) = x
62− elemAsMarkdown (Keyword x) = x
63− elemAsMarkdown Space = " "
64−
65−childToString :: First -> RenderedChildDeclaration -> String
66−childToString f RenderedChildDeclaration{..} =
67− case rcdType of
68− ChildDataConstructor ->
69− let c = if f == First then "=" else "|"
70− in " " ++ c ++ " " ++ codeToString rcdCode
71− ChildTypeClassMember ->
72− " " ++ codeToString rcdCode
73− ChildInstance ->
74− codeToString rcdCode
75−
76−data First
77− = First
78− | NotFirst
79− deriving (Show, Eq, Ord)
80−
81−type Docs = Writer [String] ()
82−
83−runDocs :: Docs -> String
84−runDocs = unlines . execWriter
85−
86−tell' :: String -> Docs
87−tell' = tell . (:[])
88−
89−spacer :: Docs
90−spacer = tell' ""
91−
92−headerLevel :: Int -> String -> Docs
93−headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)
94−
95−fencedBlock :: Docs -> Docs
96−fencedBlock inner = do
97− tell' "``` purescript"
98− inner
99− tell' "```"
100−
101−ticks :: String -> String
102−ticks = ("`" ++) . (++ "`")
src/Language/PureScript/Docs/ParseAndDesugar.hsdeleted−123
@@ -1,123 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−
3−module Language.PureScript.Docs.ParseAndDesugar
4− ( parseAndDesugar
5− , ParseDesugarError(..)
6− ) where
7−
8−import qualified Data.Map as M
9−import Control.Arrow (first)
10−import Control.Monad
11−import Control.Applicative
12−
13−import Control.Monad.Trans.Except
14−import Control.Monad.Error.Class (MonadError(..))
15−import Control.Monad.IO.Class (MonadIO(..))
16−
17−import Web.Bower.PackageMeta (PackageName)
18−
19−import qualified Language.PureScript as P
20−import qualified Language.PureScript.Constants as C
21−import Language.PureScript.Docs.Types
22−import Language.PureScript.Docs.Render
23−
24−data ParseDesugarError
25− = ParseError P.MultipleErrors
26− | SortModulesError P.MultipleErrors
27− | DesugarError P.MultipleErrors
28− deriving (Show)
29−
30−-- |
31−-- Given:
32−--
33−-- * A list of local source files
34−-- * A list of source files from external dependencies, together with their
35−-- package names
36−-- * A callback, taking a list of bookmarks, and a list of desugared modules
37−--
38−-- This function does the following:
39−--
40−-- * Parse all of the input and dependency source files
41−-- * Partially desugar all of the resulting modules
42−-- * Collect a list of bookmarks from the whole set of source files
43−-- * Collect a list of desugared modules from just the input source files (not
44−-- dependencies)
45−-- * Call the callback with the bookmarks and desugared module list.
46−parseAndDesugar ::
47− [FilePath]
48− -> [(PackageName, FilePath)]
49− -> ([Bookmark] -> [P.Module] -> IO a)
50− -> IO (Either ParseDesugarError a)
51−parseAndDesugar inputFiles depsFiles callback = do
52− inputFiles' <- mapM (parseAs Local) inputFiles
53− depsFiles' <- mapM (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles
54−
55− runExceptT $ do
56− let eParsed = P.parseModulesFromFiles fileInfoToString (inputFiles' ++ depsFiles')
57− ms <- throwLeft ParseError eParsed
58−
59− let depsModules = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) ms)
60− let eSorted = P.sortModules . map (importPrim . importPrelude . snd) $ ms
61− (ms', _) <- throwLeft SortModulesError eSorted
62−
63− modules <- throwLeft DesugarError (desugar ms')
64− let modules' = map (addPackage depsModules) modules
65− bookmarks = concatMap collectBookmarks modules'
66− liftIO (callback bookmarks (takeLocals modules'))
67−
68− where
69− throwLeft f = either (throwError . f) return
70−
71−-- | Specifies whether a PureScript source file is considered as:
72−--
73−-- 1) with the `Local` constructor, a target source file, i.e., we want to see
74−-- its modules in the output
75−-- 2) with the `FromDep` constructor, a dependencies source file, i.e. we do
76−-- not want its modules in the output; it is there to enable desugaring, and
77−-- to ensure that links between modules are constructed correctly.
78−type FileInfo = InPackage FilePath
79−
80−fileInfoToString :: FileInfo -> FilePath
81−fileInfoToString (Local fn) = fn
82−fileInfoToString (FromDep _ fn) = fn
83−
84−addDefaultImport :: P.ModuleName -> P.Module -> P.Module
85−addDefaultImport toImport m@(P.Module coms mn decls exps) =
86− if isExistingImport `any` decls || mn == toImport then m
87− else P.Module coms mn (P.ImportDeclaration toImport P.Implicit Nothing : decls) exps
88− where
89− isExistingImport (P.ImportDeclaration mn' _ _) | mn' == toImport = True
90− isExistingImport (P.PositionedDeclaration _ _ d) = isExistingImport d
91− isExistingImport _ = False
92−
93−importPrim :: P.Module -> P.Module
94−importPrim = addDefaultImport (P.ModuleName [P.ProperName C.prim])
95−
96−importPrelude :: P.Module -> P.Module
97−importPrelude = addDefaultImport (P.ModuleName [P.ProperName C.prelude])
98−
99−desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]
100−desugar = P.evalSupplyT 0 . desugar'
101− where
102− desugar' :: [P.Module] -> P.SupplyT (Either P.MultipleErrors) [P.Module]
103− desugar' = mapM P.desugarDoModule >=> P.desugarCasesModule >=> P.desugarImports
104−
105−parseFile :: FilePath -> IO (FilePath, String)
106−parseFile input' = (,) input' <$> readFile input'
107−
108−parseAs :: (FilePath -> a) -> FilePath -> IO (a, String)
109−parseAs g = fmap (first g) . parseFile
110−
111−getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName
112−getDepsModuleNames = foldl go M.empty
113− where
114− go deps p = deps # case p of
115− Local _ -> id
116− FromDep pkgName (_, m) -> M.insert (P.getModuleName m) pkgName
117− (#) = flip ($)
118−
119−addPackage :: M.Map P.ModuleName PackageName -> P.Module -> InPackage P.Module
120−addPackage depsModules m =
121− case M.lookup (P.getModuleName m) depsModules of
122− Just pkgName -> FromDep pkgName m
123− Nothing -> Local m
src/Language/PureScript/Docs/Render.hsdeleted−239
@@ -1,239 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE ViewPatterns #-}
5−
6−-- | Functions for rendering documentation generated from PureScript code.
7−
8−module Language.PureScript.Docs.Render (
9− renderModule,
10− collectBookmarks
11−) where
12−
13−import Control.Monad
14−import Data.Either
15−import Data.Monoid ((<>))
16−import Data.Maybe (mapMaybe)
17−import Data.List (nub)
18−
19−import qualified Language.PureScript as P
20−
21−import Language.PureScript.Docs.RenderedCode
22−import Language.PureScript.Docs.Types
23−import Language.PureScript.Docs.Utils.MonoidExtras
24−
25−-- |
26−-- Render a single Module.
27−--
28−renderModule :: P.Module -> RenderedModule
29−renderModule m@(P.Module coms moduleName _ _) =
30− RenderedModule (show moduleName) comments declarations
31− where
32− comments = renderComments coms
33− declarations = groupChildren declarationsWithChildren
34− declarationsWithChildren = mapMaybe go (P.exportedDeclarations m)
35− go decl = getDeclarationTitle decl
36− >>= renderDeclaration decl
37−
38−-- | An intermediate stage which we go through during rendering.
39−--
40−-- In the first pass, we take all top level declarations in the module, and
41−-- render those which should appear at the top level in the output, as well as
42−-- those which should appear as children of other declarations in the output.
43−--
44−-- In the second pass, we move all children under their respective parents,
45−-- or discard them if none are found.
46−--
47−-- This two-pass system is only necessary for type instance declarations, since
48−-- they appear at the top level in the AST, and since they might need to appear
49−-- as children in two places (for example, if a data type defined in a module
50−-- is an instance of a type class also defined in that module).
51−--
52−-- This data type is used as an intermediate type between the two stages. The
53−-- Left case is a child declaration, together with a list of parent declaration
54−-- titles which this may appear as a child of.
55−--
56−-- The Right case is a top level declaration which should pass straight through
57−-- the second stage; the only way it might change is if child declarations are
58−-- added to it.
59−type IntermediateDeclaration
60− = Either ([String], RenderedChildDeclaration) RenderedDeclaration
61−
62−-- | Move child declarations into their respective parents; the second pass.
63−-- See the comments under the type synonym IntermediateDeclaration for more
64−-- information.
65−groupChildren :: [IntermediateDeclaration] -> [RenderedDeclaration]
66−groupChildren (partitionEithers -> (children, toplevels)) =
67− foldl go toplevels children
68− where
69− go ds (parentTitles, child) =
70− map (\d ->
71− if rdTitle d `elem` parentTitles
72− then d { rdChildren = rdChildren d ++ [child] }
73− else d) ds
74−
75−getDeclarationTitle :: P.Declaration -> Maybe String
76−getDeclarationTitle (P.TypeDeclaration name _) = Just (show name)
77−getDeclarationTitle (P.ExternDeclaration name _) = Just (show name)
78−getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (show name)
79−getDeclarationTitle (P.ExternDataDeclaration name _) = Just (show name)
80−getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (show name)
81−getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (show name)
82−getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (show name)
83−getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d
84−getDeclarationTitle _ = Nothing
85−
86−basicDeclaration :: String -> RenderedCode -> Maybe IntermediateDeclaration
87−basicDeclaration title code = Just (Right (RenderedDeclaration title Nothing code Nothing []))
88−
89−renderDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration
90−renderDeclaration (P.TypeDeclaration ident' ty) title =
91− basicDeclaration title code
92− where
93− code = ident (show ident')
94− <> sp <> syntax "::" <> sp
95− <> renderType ty
96−renderDeclaration (P.ExternDeclaration ident' ty) title =
97− basicDeclaration title code
98− where
99− code = ident (show ident')
100− <> sp <> syntax "::" <> sp
101− <> renderType ty
102−renderDeclaration (P.DataDeclaration dtype name args ctors) title =
103− Just (Right (RenderedDeclaration title Nothing code Nothing children))
104− where
105− typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
106− code = keyword (show dtype) <> sp <> renderType typeApp
107− children = map renderCtor ctors
108− -- TODO: Comments for data constructors?
109− renderCtor (ctor', tys) =
110− let typeApp' = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing ctor')) tys
111− childCode = renderType typeApp'
112− in RenderedChildDeclaration (show ctor') Nothing childCode Nothing ChildDataConstructor
113−renderDeclaration (P.ExternDataDeclaration name kind') title =
114− basicDeclaration title code
115− where
116− code = keywordData <> sp
117− <> renderType (P.TypeConstructor (P.Qualified Nothing name))
118− <> sp <> syntax "::" <> sp
119− <> renderKind kind'
120−renderDeclaration (P.TypeSynonymDeclaration name args ty) title =
121− basicDeclaration title code
122− where
123− typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
124− code = mintersperse sp
125− [ keywordType
126− , renderType typeApp
127− , syntax "="
128− , renderType ty
129− ]
130−renderDeclaration (P.TypeClassDeclaration name args implies ds) title = do
131− Just (Right (RenderedDeclaration title Nothing code Nothing children))
132− where
133− code = mintersperse sp $
134− [keywordClass]
135− ++ maybe [] (:[]) superclasses
136− ++ [renderType classApp]
137− ++ if (not (null ds)) then [keywordWhere] else []
138−
139− superclasses
140− | null implies = Nothing
141− | otherwise = Just $
142− syntax "("
143− <> mintersperse (syntax "," <> sp) (map renderImplies implies)
144− <> syntax ") <="
145−
146− renderImplies (pn, tys) =
147− let supApp = foldl P.TypeApp (P.TypeConstructor pn) tys
148− in renderType supApp
149−
150− classApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
151−
152− children = map renderClassMember ds
153−
154− -- TODO: Comments for type class members
155− renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d
156− renderClassMember (P.TypeDeclaration ident' ty) =
157− let childCode =
158− mintersperse sp
159− [ ident (show ident')
160− , syntax "::"
161− , renderType ty
162− ]
163− in RenderedChildDeclaration (show ident') Nothing childCode Nothing ChildTypeClassMember
164− renderClassMember _ = error "Invalid argument to renderClassMember."
165−renderDeclaration (P.TypeInstanceDeclaration name constraints className tys _) title = do
166− Just (Left (classNameString : typeNameStrings, childDecl))
167− where
168− classNameString = unQual className
169− typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)
170− unQual x = let (P.Qualified _ y) = x in show y
171−
172− extractProperNames (P.TypeConstructor n) = [unQual n]
173− extractProperNames (P.SaturatedTypeSynonym n _) = [unQual n]
174− extractProperNames _ = []
175−
176− childDecl = RenderedChildDeclaration title Nothing code Nothing ChildInstance
177−
178− code =
179− mintersperse sp $
180− [ keywordInstance
181− , ident (show name)
182− , syntax "::"
183− ] ++ maybe [] (:[]) constraints'
184− ++ [ renderType classApp ]
185−
186− constraints'
187− | null constraints = Nothing
188− | otherwise = Just (syntax "(" <> renderedConstraints <> syntax ") =>")
189−
190− renderedConstraints = mintersperse (syntax "," <> sp) (map renderConstraint constraints)
191−
192− renderConstraint (pn, tys') =
193− let supApp = foldl P.TypeApp (P.TypeConstructor pn) tys'
194− in renderType supApp
195−
196− classApp = foldl P.TypeApp (P.TypeConstructor className) tys
197−renderDeclaration (P.PositionedDeclaration srcSpan com d') title =
198− fmap (addComments . addSourceSpan) (renderDeclaration d' title)
199− where
200− addComments (Left (t, d)) = Left (t, d { rcdComments = renderComments com })
201− addComments (Right d) = Right (d { rdComments = renderComments com })
202−
203− addSourceSpan (Left (t, d)) = Left (t, d { rcdSourceSpan = Just srcSpan })
204− addSourceSpan (Right d) = Right (d { rdSourceSpan = Just srcSpan })
205−renderDeclaration _ _ = Nothing
206−
207−renderComments :: [P.Comment] -> Maybe String
208−renderComments cs = do
209− let raw = concatMap toLines cs
210− guard (all hasPipe raw && not (null raw))
211− return (go raw)
212− where
213− go = unlines . map stripPipes
214−
215− toLines (P.LineComment s) = [s]
216− toLines (P.BlockComment s) = lines s
217−
218− hasPipe s = case dropWhile (== ' ') s of { ('|':_) -> True; _ -> False }
219−
220− stripPipes = dropPipe . dropWhile (== ' ')
221−
222− dropPipe ('|':' ':s) = s
223− dropPipe ('|':s) = s
224− dropPipe s = s
225−
226−toTypeVar :: (String, Maybe P.Kind) -> P.Type
227−toTypeVar (s, Nothing) = P.TypeVar s
228−toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k
229−
230−collectBookmarks :: InPackage P.Module -> [Bookmark]
231−collectBookmarks (Local m) = map Local (collectBookmarks' m)
232−collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)
233−
234−collectBookmarks' :: P.Module -> [(P.ModuleName, String)]
235−collectBookmarks' m =
236− map (P.getModuleName m, )
237− (mapMaybe getDeclarationTitle
238− (P.exportedDeclarations m))
239−
src/Language/PureScript/Docs/RenderedCode.hsdeleted−11
@@ -1,11 +0,0 @@
1−
2−-- | Data types and functions for representing a simplified form of PureScript
3−-- code, intended for use in e.g. HTML documentation.
4−
5−module Language.PureScript.Docs.RenderedCode (
6− module RenderedCode
7−) where
8−
9−import Language.PureScript.Docs.RenderedCode.Types as RenderedCode
10−import Language.PureScript.Docs.RenderedCode.Render as RenderedCode
11−
src/Language/PureScript/Docs/RenderedCode/Render.hsdeleted−165
@@ -1,165 +0,0 @@
1−
2−-- | Functions for producing RenderedCode values from PureScript Type values.
3−
4−module Language.PureScript.Docs.RenderedCode.Render (
5− renderType,
6− renderTypeAtom,
7− renderRow,
8− renderKind
9−) where
10−
11−import Data.Monoid ((<>), mconcat, mempty)
12−import Data.Maybe (fromMaybe)
13−
14−import Control.Arrow ((<+>))
15−import Control.PatternArrows
16−
17−import Language.PureScript.Names
18−import Language.PureScript.Types
19−import Language.PureScript.Kinds
20−import Language.PureScript.Pretty.Kinds
21−import Language.PureScript.Environment
22−
23−import Language.PureScript.Docs.RenderedCode.Types
24−import Language.PureScript.Docs.Utils.MonoidExtras
25−
26−typeLiterals :: Pattern () Type RenderedCode
27−typeLiterals = mkPattern match
28− where
29− match TypeWildcard =
30− Just (syntax "_")
31− match (TypeVar var) =
32− Just (ident var)
33− match (PrettyPrintObject row) =
34− Just $ mintersperse sp
35− [ syntax "{"
36− , renderRow row
37− , syntax "}"
38− ]
39− match (TypeConstructor (Qualified mn name)) =
40− Just (ctor (show name) (maybeToContainingModule mn))
41− match (ConstrainedType deps ty) =
42− Just $ mintersperse sp
43− [ syntax "(" <> constraints <> syntax ")"
44− , syntax "=>"
45− , renderType ty
46− ]
47− where
48− constraints = mintersperse (syntax "," <> sp) (map renderDep deps)
49− renderDep (pn, tys) =
50− let instApp = foldl TypeApp (TypeConstructor pn) tys
51− in renderType instApp
52− match REmpty =
53− Just (syntax "()")
54− match row@RCons{} =
55− Just (syntax "(" <> renderRow row <> syntax ")")
56− match _ =
57− Nothing
58−
59−-- |
60−-- Render code representing a Row
61−--
62−renderRow :: Type -> RenderedCode
63−renderRow = uncurry renderRow' . rowToList
64− where
65− renderRow' h t = renderHead h <> renderTail t
66−
67−renderHead :: [(String, Type)] -> RenderedCode
68−renderHead = mintersperse (syntax "," <> sp) . map renderLabel
69−
70−renderLabel :: (String, Type) -> RenderedCode
71−renderLabel (label, ty) =
72− mintersperse sp
73− [ ident label
74− , syntax "::"
75− , renderType ty
76− ]
77−
78−renderTail :: Type -> RenderedCode
79−renderTail REmpty = mempty
80−renderTail other = sp <> syntax "|" <> sp <> renderType other
81−
82−typeApp :: Pattern () Type (Type, Type)
83−typeApp = mkPattern match
84− where
85− match (TypeApp f x) = Just (f, x)
86− match _ = Nothing
87−
88−appliedFunction :: Pattern () Type (Type, Type)
89−appliedFunction = mkPattern match
90− where
91− match (PrettyPrintFunction arg ret) = Just (arg, ret)
92− match _ = Nothing
93−
94−kinded :: Pattern () Type (Kind, Type)
95−kinded = mkPattern match
96− where
97− match (KindedType t k) = Just (k, t)
98− match _ = Nothing
99−
100−matchTypeAtom :: Pattern () Type RenderedCode
101−matchTypeAtom = typeLiterals <+> fmap parens matchType
102− where
103− parens x = syntax "(" <> x <> syntax ")"
104−
105−matchType :: Pattern () Type RenderedCode
106−matchType = buildPrettyPrinter operators matchTypeAtom
107− where
108− operators :: OperatorTable () Type RenderedCode
109− operators =
110− OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]
111− , [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]
112− , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]
113− , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]
114− ]
115−
116−forall_ :: Pattern () Type ([String], Type)
117−forall_ = mkPattern match
118− where
119− match (PrettyPrintForAll idents ty) = Just (idents, ty)
120− match _ = Nothing
121−
122−insertPlaceholders :: Type -> Type
123−insertPlaceholders =
124− everywhereOnTypesTopDown convertForAlls . everywhereOnTypes convert
125−
126−dePrim :: Type -> Type
127−dePrim ty@(TypeConstructor (Qualified _ name))
128− | ty == tyBoolean || ty == tyNumber || ty == tyString =
129− TypeConstructor $ Qualified Nothing name
130−dePrim other = other
131−
132−convert :: Type -> Type
133−convert (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret
134−convert (TypeApp o r) | o == tyObject = PrettyPrintObject r
135−convert other = other
136−
137−convertForAlls :: Type -> Type
138−convertForAlls (ForAll i ty _) = go [i] ty
139− where
140− go idents (ForAll ident' ty' _) = go (ident' : idents) ty'
141− go idents other = PrettyPrintForAll idents other
142−convertForAlls other = other
143−
144−preprocessType :: Type -> Type
145−preprocessType = dePrim . insertPlaceholders
146−
147−-- |
148−-- Render code representing a Kind
149−--
150−renderKind :: Kind -> RenderedCode
151−renderKind = kind . prettyPrintKind
152−
153−-- |
154−-- Render code representing a Type, as it should appear inside parentheses
155−--
156−renderTypeAtom :: Type -> RenderedCode
157−renderTypeAtom = fromMaybe (error "Incomplete pattern") . pattern matchTypeAtom () . preprocessType
158−
159−
160−-- |
161−-- Render code representing a Type
162−--
163−renderType :: Type -> RenderedCode
164−renderType = fromMaybe (error "Incomplete pattern") . pattern matchType () . preprocessType
165−
src/Language/PureScript/Docs/RenderedCode/Types.hsdeleted−191
@@ -1,191 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−-- | Data types and functions for representing a simplified form of PureScript
5−-- code, intended for use in e.g. HTML documentation.
6−
7−module Language.PureScript.Docs.RenderedCode.Types
8− ( RenderedCodeElement(..)
9− , asRenderedCodeElement
10− , ContainingModule(..)
11− , asContainingModule
12− , containingModuleToMaybe
13− , maybeToContainingModule
14− , fromContainingModule
15− , RenderedCode
16− , asRenderedCode
17− , outputWith
18− , sp
19− , syntax
20− , ident
21− , ctor
22− , kind
23− , keyword
24− , keywordForall
25− , keywordData
26− , keywordNewtype
27− , keywordType
28− , keywordClass
29− , keywordInstance
30− , keywordWhere
31− ) where
32−
33−import Control.Applicative ((<$>), (<*>), (*>), pure)
34−import Data.Foldable
35−import Data.Monoid
36−import qualified Data.Aeson as A
37−import Data.Aeson.BetterErrors
38−import Control.Monad.Error.Class (MonadError(..))
39−
40−import qualified Language.PureScript as P
41−
42−-- |
43−-- A single element in a rendered code fragment. The intention is to support
44−-- multiple output formats. For example, plain text, or highlighted HTML.
45−--
46−data RenderedCodeElement
47− = Syntax String
48− | Ident String
49− | Ctor String ContainingModule
50− | Kind String
51− | Keyword String
52− | Space
53− deriving (Show, Eq, Ord)
54−
55−instance A.ToJSON RenderedCodeElement where
56− toJSON (Syntax str) =
57− A.toJSON ["syntax", str]
58− toJSON (Ident str) =
59− A.toJSON ["ident", str]
60− toJSON (Ctor str mn) =
61− A.toJSON ["ctor", A.toJSON str, A.toJSON mn ]
62− toJSON (Kind str) =
63− A.toJSON ["kind", str]
64− toJSON (Keyword str) =
65− A.toJSON ["keyword", str]
66− toJSON Space =
67− A.toJSON ["space" :: String]
68−
69−asRenderedCodeElement :: Parse String RenderedCodeElement
70−asRenderedCodeElement =
71− a Syntax "syntax" <|>
72− a Ident "ident" <|>
73− asCtor <|>
74− a Kind "kind" <|>
75− a Keyword "keyword" <|>
76− asSpace <|>
77− unableToParse
78− where
79− p <|> q = catchError p (const q)
80−
81− a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)
82− asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)
83− asSpace = nth 0 (withString (eq "space")) *> pure Space
84−
85− eq s s' = if s == s' then Right () else Left ""
86−
87− unableToParse = withString (Left . show)
88−
89−-- |
90−-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier
91−-- to read, as the meaning is more explicit.
92−--
93−data ContainingModule
94− = ThisModule
95− | OtherModule P.ModuleName
96− deriving (Show, Eq, Ord)
97−
98−instance A.ToJSON ContainingModule where
99− toJSON mn = A.toJSON (P.runModuleName <$> containingModuleToMaybe mn)
100−
101−asContainingModule :: Parse e ContainingModule
102−asContainingModule =
103− maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asString)
104−
105−-- |
106−-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious
107−-- isomorphism.
108−--
109−maybeToContainingModule :: Maybe P.ModuleName -> ContainingModule
110−maybeToContainingModule Nothing = ThisModule
111−maybeToContainingModule (Just mn) = OtherModule mn
112−
113−-- |
114−-- Convert a 'ContainingModule' to a 'Maybe' 'P.ModuleName', using the obvious
115−-- isomorphism.
116−--
117−containingModuleToMaybe :: ContainingModule -> Maybe P.ModuleName
118−containingModuleToMaybe ThisModule = Nothing
119−containingModuleToMaybe (OtherModule mn) = Just mn
120−
121−-- |
122−-- A version of 'fromMaybe' for 'ContainingModule' values.
123−--
124−fromContainingModule :: P.ModuleName -> ContainingModule -> P.ModuleName
125−fromContainingModule def ThisModule = def
126−fromContainingModule _ (OtherModule mn) = mn
127−
128−-- |
129−-- A type representing a highly simplified version of PureScript code, intended
130−-- for use in output formats like plain text or HTML.
131−--
132−newtype RenderedCode
133− = RC { unRC :: [RenderedCodeElement] }
134− deriving (Show, Eq, Ord, Monoid)
135−
136−instance A.ToJSON RenderedCode where
137− toJSON (RC elems) = A.toJSON elems
138−
139−asRenderedCode :: Parse String RenderedCode
140−asRenderedCode = RC <$> eachInArray asRenderedCodeElement
141−
142−-- |
143−-- This function allows conversion of a 'RenderedCode' value into a value of
144−-- some other type (for example, plain text, or HTML). The first argument
145−-- is a function specifying how each individual 'RenderedCodeElement' should be
146−-- rendered.
147−--
148−outputWith :: Monoid a => (RenderedCodeElement -> a) -> RenderedCode -> a
149−outputWith f = foldMap f . unRC
150−
151−-- |
152−-- A 'RenderedCode' fragment representing a space.
153−--
154−sp :: RenderedCode
155−sp = RC [Space]
156−
157−syntax :: String -> RenderedCode
158−syntax x = RC [Syntax x]
159−
160−ident :: String -> RenderedCode
161−ident x = RC [Ident x]
162−
163−ctor :: String -> ContainingModule -> RenderedCode
164−ctor x m = RC [Ctor x m]
165−
166−kind :: String -> RenderedCode
167−kind x = RC [Kind x]
168−
169−keyword :: String -> RenderedCode
170−keyword kw = RC [Keyword kw]
171−
172−keywordForall :: RenderedCode
173−keywordForall = keyword "forall"
174−
175−keywordData :: RenderedCode
176−keywordData = keyword "data"
177−
178−keywordNewtype :: RenderedCode
179−keywordNewtype = keyword "newtype"
180−
181−keywordType :: RenderedCode
182−keywordType = keyword "type"
183−
184−keywordClass :: RenderedCode
185−keywordClass = keyword "class"
186−
187−keywordInstance :: RenderedCode
188−keywordInstance = keyword "instance"
189−
190−keywordWhere :: RenderedCode
191−keywordWhere = keyword "where"
src/Language/PureScript/Docs/Types.hsdeleted−335
@@ -1,335 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TupleSections #-}
4−{-# LANGUAGE RankNTypes #-}
5−
6−module Language.PureScript.Docs.Types
7− ( module Language.PureScript.Docs.Types
8− , module ReExports
9− )
10− where
11−
12−import Control.Arrow (first, (***))
13−import Control.Applicative ((<$>), (<*>))
14−import Data.Functor ((<$))
15−import Data.Char
16−import Data.Maybe (mapMaybe)
17−import Data.Version
18−import Data.Aeson ((.=))
19−import qualified Data.Aeson as A
20−import Data.Aeson.BetterErrors
21−import Text.ParserCombinators.ReadP (readP_to_S)
22−import Data.Text (Text)
23−import Data.ByteString.Lazy (ByteString)
24−import qualified Data.Text as T
25−
26−import Web.Bower.PackageMeta hiding (Version)
27−
28−import qualified Language.PureScript as P
29−
30−import Language.PureScript.Docs.RenderedCode as ReExports
31− (RenderedCode, asRenderedCode,
32− ContainingModule(..), asContainingModule,
33− RenderedCodeElement(..), asRenderedCodeElement)
34−
35−--------------------
36−-- Types
37−
38−data Package a = Package
39− { pkgMeta :: PackageMeta
40− , pkgVersion :: Version
41− , pkgVersionTag :: String
42− , pkgModules :: [RenderedModule]
43− , pkgBookmarks :: [Bookmark]
44− , pkgResolvedDependencies :: [(PackageName, Version)]
45− , pkgGithub :: (GithubUser, GithubRepo)
46− , pkgUploader :: a
47− }
48− deriving (Show, Eq, Ord)
49−
50−data NotYetKnown = NotYetKnown
51− deriving (Show, Eq, Ord)
52−
53−type UploadedPackage = Package NotYetKnown
54−type VerifiedPackage = Package GithubUser
55−
56−verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage
57−verifyPackage verifiedUser Package{..} =
58− Package pkgMeta
59− pkgVersion
60− pkgVersionTag
61− pkgModules
62− pkgBookmarks
63− pkgResolvedDependencies
64− pkgGithub
65− verifiedUser
66−
67−packageName :: Package a -> PackageName
68−packageName = bowerName . pkgMeta
69−
70−data RenderedModule = RenderedModule
71− { rmName :: String
72− , rmComments :: Maybe String
73− , rmDeclarations :: [RenderedDeclaration]
74− }
75− deriving (Show, Eq, Ord)
76−
77−data RenderedDeclaration = RenderedDeclaration
78− { rdTitle :: String
79− , rdComments :: Maybe String
80− , rdCode :: RenderedCode
81− , rdSourceSpan :: Maybe P.SourceSpan
82− , rdChildren :: [RenderedChildDeclaration]
83− }
84− deriving (Show, Eq, Ord)
85−
86−data RenderedChildDeclaration = RenderedChildDeclaration
87− { rcdTitle :: String
88− , rcdComments :: Maybe String
89− , rcdCode :: RenderedCode
90− , rcdSourceSpan :: Maybe P.SourceSpan
91− , rcdType :: RenderedChildDeclarationType
92− }
93− deriving (Show, Eq, Ord)
94−
95−data RenderedChildDeclarationType
96− = ChildInstance
97− | ChildDataConstructor
98− | ChildTypeClassMember
99− deriving (Show, Eq, Ord, Bounded, Enum)
100−
101−childDeclTypeToString :: RenderedChildDeclarationType -> String
102−childDeclTypeToString = withHead toLower . drop 5 . show
103− where
104− withHead f (x:xs) = f x : xs
105− withHead _ [] = []
106−
107−childDeclarationTypes :: [(String, RenderedChildDeclarationType)]
108−childDeclarationTypes =
109− map (\t -> (childDeclTypeToString t, t)) [minBound .. maxBound]
110−
111−newtype GithubUser
112− = GithubUser { runGithubUser :: String }
113− deriving (Show, Eq, Ord)
114−
115−newtype GithubRepo
116− = GithubRepo { runGithubRepo :: String }
117− deriving (Show, Eq, Ord)
118−
119−data PackageError
120− = ErrorInPackageMeta BowerError
121− | InvalidVersion
122− | InvalidDeclarationType
123− | InvalidRenderedCode String
124− deriving (Show, Eq, Ord)
125−
126−type Bookmark = InPackage (P.ModuleName, String)
127−
128−data InPackage a
129− = Local a
130− | FromDep PackageName a
131− deriving (Show, Eq, Ord)
132−
133−instance Functor InPackage where
134− fmap f (Local x) = Local (f x)
135− fmap f (FromDep pkgName x) = FromDep pkgName (f x)
136−
137−takeLocal :: InPackage a -> Maybe a
138−takeLocal (Local a) = Just a
139−takeLocal _ = Nothing
140−
141−takeLocals :: [InPackage a] -> [a]
142−takeLocals = mapMaybe takeLocal
143−
144−ignorePackage :: InPackage a -> a
145−ignorePackage (Local x) = x
146−ignorePackage (FromDep _ x) = x
147−
148−----------------------
149−-- Parsing
150−
151−parseUploadedPackage :: ByteString -> Either (ParseError PackageError) UploadedPackage
152−parseUploadedPackage = parse asUploadedPackage
153−
154−parseVerifiedPackage :: ByteString -> Either (ParseError PackageError) VerifiedPackage
155−parseVerifiedPackage = parse asVerifiedPackage
156−
157−asPackage :: (forall e. Parse e a) -> Parse PackageError (Package a)
158−asPackage uploader =
159− Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta
160− <*> key "version" asVersion
161− <*> key "versionTag" asString
162− <*> key "modules" (eachInArray asRenderedModule)
163− <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta
164− <*> key "resolvedDependencies" asResolvedDependencies
165− <*> key "github" asGithub
166− <*> key "uploader" uploader
167−
168−asUploadedPackage :: Parse PackageError UploadedPackage
169−asUploadedPackage = asPackage asNotYetKnown
170−
171−asNotYetKnown :: Parse e NotYetKnown
172−asNotYetKnown = NotYetKnown <$ asNull
173−
174−instance A.FromJSON NotYetKnown where
175− parseJSON = toAesonParser' asNotYetKnown
176−
177−asVerifiedPackage :: Parse PackageError VerifiedPackage
178−asVerifiedPackage = asPackage asGithubUser
179−
180−asGithubUser :: Parse e GithubUser
181−asGithubUser = GithubUser <$> asString
182−
183−instance A.FromJSON GithubUser where
184− parseJSON = toAesonParser' asGithubUser
185−
186−instance A.FromJSON a => A.FromJSON (Package a) where
187− -- TODO: actual error display
188− parseJSON = toAesonParser (T.pack . show)
189− (asPackage fromAesonParser)
190−
191−asVersion :: Parse PackageError Version
192−asVersion = withString (maybe (Left InvalidVersion) Right . parseVersion')
193−
194−parseVersion' :: String -> Maybe Version
195−parseVersion' str =
196− case filter (null . snd) $ readP_to_S parseVersion str of
197− [(vers, "")] -> Just vers
198− _ -> Nothing
199−
200−asRenderedModule :: Parse PackageError RenderedModule
201−asRenderedModule =
202− RenderedModule <$> key "name" asString
203− <*> key "comments" (perhaps asString)
204− <*> key "declarations" (eachInArray asDeclaration)
205−
206−asDeclaration :: Parse PackageError RenderedDeclaration
207−asDeclaration =
208− RenderedDeclaration <$> key "title" asString
209− <*> key "comments" (perhaps asString)
210− <*> key "code" asRenderedCode .! InvalidRenderedCode
211− <*> key "sourceSpan" (perhaps asSourceSpan)
212− <*> key "children" (eachInArray asRenderedChildDeclaration)
213−
214−asRenderedChildDeclaration :: Parse PackageError RenderedChildDeclaration
215−asRenderedChildDeclaration =
216− RenderedChildDeclaration <$> key "title" asString
217− <*> key "comments" (perhaps asString)
218− <*> key "code" asRenderedCode .! InvalidRenderedCode
219− <*> key "sourceSpan" (perhaps asSourceSpan)
220− <*> key "type" asRenderedChildDeclarationType .!! InvalidDeclarationType
221− where
222− p .!! err = p .! const err
223−
224−asRenderedChildDeclarationType :: Parse PackageError RenderedChildDeclarationType
225−asRenderedChildDeclarationType =
226− withString (maybe (Left InvalidDeclarationType) Right .
227− flip lookup childDeclarationTypes)
228−
229−asSourcePos :: Parse e P.SourcePos
230−asSourcePos = P.SourcePos <$> nth 0 asIntegral
231− <*> nth 1 asIntegral
232−
233−asBookmarks :: Parse BowerError [Bookmark]
234−asBookmarks = eachInArray asBookmark
235−
236−asBookmark :: Parse BowerError Bookmark
237−asBookmark =
238− build <$> key "package" (perhaps (withString parsePackageName))
239− <*> key "item" ((,) <$> nth 0 (P.moduleNameFromString <$> asString)
240− <*> nth 1 asString)
241− where
242− build Nothing = Local
243− build (Just pn) = FromDep pn
244−
245−asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
246−asResolvedDependencies =
247− eachInObjectWithKey (mapLeft ErrorInPackageMeta . parsePackageName . T.unpack) asVersion
248− where
249− mapLeft f (Left x) = Left (f x)
250− mapLeft _ (Right x) = Right x
251−
252−asGithub :: Parse e (GithubUser, GithubRepo)
253−asGithub = (,) <$> nth 0 (GithubUser <$> asString)
254− <*> nth 1 (GithubRepo <$> asString)
255−
256−asSourceSpan :: Parse e P.SourceSpan
257−asSourceSpan = P.SourceSpan <$> key "name" asString
258− <*> key "start" asSourcePos
259− <*> key "end" asSourcePos
260−
261−---------------------
262−-- ToJSON instances
263−
264−instance A.ToJSON a => A.ToJSON (Package a) where
265− toJSON Package{..} =
266− A.object $
267− [ "packageMeta" .= pkgMeta
268− , "version" .= showVersion pkgVersion
269− , "versionTag" .= pkgVersionTag
270− , "modules" .= pkgModules
271− , "bookmarks" .= map (fmap (first P.runModuleName)) pkgBookmarks
272− , "resolvedDependencies" .= assocListToJSON (T.pack . runPackageName)
273− (T.pack . showVersion)
274− pkgResolvedDependencies
275− , "github" .= pkgGithub
276− , "uploader" .= pkgUploader
277− ]
278−
279−instance A.ToJSON NotYetKnown where
280− toJSON _ = A.Null
281−
282−instance A.ToJSON RenderedModule where
283− toJSON RenderedModule{..} =
284− A.object [ "name" .= rmName
285− , "comments" .= rmComments
286− , "declarations" .= rmDeclarations
287− ]
288−
289−instance A.ToJSON RenderedDeclaration where
290− toJSON RenderedDeclaration{..} =
291− A.object [ "title" .= rdTitle
292− , "comments" .= rdComments
293− , "code" .= rdCode
294− , "sourceSpan" .= rdSourceSpan
295− , "children" .= rdChildren
296− ]
297−
298−instance A.ToJSON RenderedChildDeclaration where
299− toJSON RenderedChildDeclaration{..} =
300− A.object [ "title" .= rcdTitle
301− , "comments" .= rcdComments
302− , "code" .= rcdCode
303− , "sourceSpan" .= rcdSourceSpan
304− , "type" .= rcdType
305− ]
306−
307−instance A.ToJSON RenderedChildDeclarationType where
308− toJSON = A.toJSON . childDeclTypeToString
309−
310−instance A.ToJSON GithubUser where
311− toJSON = A.toJSON . runGithubUser
312−
313−instance A.ToJSON GithubRepo where
314− toJSON = A.toJSON . runGithubRepo
315−
316−-- | Given a function for turning association list keys into JSON object keys,
317−-- and a function for turning association list values to JSON string values,
318−-- turns an association list into a JSON object.
319−--
320−-- For example:
321−-- @assocListToJSON T.pack T.pack [("a", "b")]@ will give @{"a": "b"}@.
322−assocListToJSON :: (a -> Text) -> (b -> Text) -> [(a, b)] -> A.Value
323−assocListToJSON f g xs = A.object (map (uncurry (.=) . (f *** g)) xs)
324−
325−instance A.ToJSON a => A.ToJSON (InPackage a) where
326− toJSON x =
327− case x of
328− Local y -> withPackage (Nothing :: Maybe ()) y
329− FromDep pn y -> withPackage (Just pn) y
330− where
331− withPackage :: (A.ToJSON p, A.ToJSON x) => p -> x -> A.Value
332− withPackage p y =
333− A.object [ "package" .= p
334− , "item" .= y
335− ]
src/Language/PureScript/Docs/Utils/MonoidExtras.hsdeleted−9
@@ -1,9 +0,0 @@
1−module Language.PureScript.Docs.Utils.MonoidExtras where
2−
3−import Data.Monoid
4−
5−mintersperse :: (Monoid m) => m -> [m] -> m
6−mintersperse _ [] = mempty
7−mintersperse _ [x] = x
8−mintersperse sep (x:xs) = x <> sep <> mintersperse sep xs
9−
src/Language/PureScript/Environment.hsdeleted−247
@@ -1,247 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Environment
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−
17−module Language.PureScript.Environment where
18−
19−import Data.Data
20−import Data.Maybe (fromMaybe)
21−import qualified Data.Map as M
22−
23−import Language.PureScript.Kinds
24−import Language.PureScript.Names
25−import Language.PureScript.TypeClassDictionaries
26−import Language.PureScript.Types
27−import qualified Language.PureScript.Constants as C
28−
29−-- |
30−-- The @Environment@ defines all values and types which are currently in scope:
31−--
32−data Environment = Environment {
33− -- |
34− -- Value names currently in scope
35− --
36− names :: M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
37− -- |
38− -- Type names currently in scope
39− --
40− , types :: M.Map (Qualified ProperName) (Kind, TypeKind)
41− -- |
42− -- Data constructors currently in scope, along with their associated data type constructors
43− --
44− , dataConstructors :: M.Map (Qualified ProperName) (DataDeclType, ProperName, Type, [Ident])
45− -- |
46− -- Type synonyms currently in scope
47− --
48− , typeSynonyms :: M.Map (Qualified ProperName) ([(String, Maybe Kind)], Type)
49− -- |
50− -- Available type class dictionaries
51− --
52− , typeClassDictionaries :: M.Map (Qualified Ident, Maybe ModuleName) TypeClassDictionaryInScope
53− -- |
54− -- Type classes
55− --
56− , typeClasses :: M.Map (Qualified ProperName) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
57− } deriving (Show)
58−
59−-- |
60−-- The initial environment with no values and only the default javascript types defined
61−--
62−initEnvironment :: Environment
63−initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty M.empty
64−
65−-- |
66−-- The visibility of a name in scope
67−--
68−data NameVisibility
69− -- |
70− -- The name is defined in the current binding group, but is not visible
71− --
72− = Undefined
73− -- |
74− -- The name is defined in the another binding group, or has been made visible by a function binder
75− --
76− | Defined deriving (Show, Eq)
77−
78−-- |
79−-- A flag for whether a name is for an private or public value - only public values will be
80−-- included in a generated externs file.
81−--
82−data NameKind
83− -- |
84− -- A private value introduced as an artifact of code generation (class instances, class member
85− -- accessors, etc.)
86− --
87− = Private
88− -- |
89− -- A public value for a module member or foreing import declaration
90− --
91− | Public
92− -- |
93− -- A name for member introduced by foreign import
94− --
95− | External deriving (Show, Eq, Data, Typeable)
96−
97−-- |
98−-- The kinds of a type
99−--
100−data TypeKind
101− -- |
102− -- Data type
103− --
104− = DataType [(String, Maybe Kind)] [(ProperName, [Type])]
105− -- |
106− -- Type synonym
107− --
108− | TypeSynonym
109− -- |
110− -- Foreign data
111− --
112− | ExternData
113− -- |
114− -- A local type variable
115− --
116− | LocalTypeVariable
117− -- |
118− -- A scoped type variable
119− --
120− | ScopedTypeVar
121− deriving (Show, Eq, Data, Typeable)
122−
123−-- |
124−-- The type ('data' or 'newtype') of a data type declaration
125−--
126−data DataDeclType
127− -- |
128− -- A standard data constructor
129− --
130− = Data
131− -- |
132− -- A newtype constructor
133− --
134− | Newtype deriving (Eq, Ord, Data, Typeable)
135−
136−instance Show DataDeclType where
137− show Data = "data"
138− show Newtype = "newtype"
139−
140−-- |
141−-- Construct a ProperName in the Prim module
142−--
143−primName :: String -> Qualified ProperName
144−primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
145−
146−-- |
147−-- Construct a type in the Prim module
148−--
149−primTy :: String -> Type
150−primTy = TypeConstructor . primName
151−
152−-- |
153−-- Type constructor for functions
154−--
155−tyFunction :: Type
156−tyFunction = primTy "Function"
157−
158−-- |
159−-- Type constructor for strings
160−--
161−tyString :: Type
162−tyString = primTy "String"
163−
164−-- |
165−-- Type constructor for strings
166−--
167−tyChar :: Type
168−tyChar = primTy "Char"
169−
170−-- |
171−-- Type constructor for numbers
172−--
173−tyNumber :: Type
174−tyNumber = primTy "Number"
175−
176−-- |
177−-- Type constructor for integers
178−--
179−tyInt :: Type
180−tyInt = primTy "Int"
181−
182−-- |
183−-- Type constructor for booleans
184−--
185−tyBoolean :: Type
186−tyBoolean = primTy "Boolean"
187−
188−-- |
189−-- Type constructor for arrays
190−--
191−tyArray :: Type
192−tyArray = primTy "Array"
193−
194−-- |
195−-- Type constructor for objects
196−--
197−tyObject :: Type
198−tyObject = primTy "Object"
199−
200−-- |
201−-- Check whether a type is an object
202−--
203−isObject :: Type -> Bool
204−isObject = (==) tyObject . extract
205− where extract (TypeApp t _) = t
206− extract t = t
207−
208−-- |
209−-- Smart constructor for function types
210−--
211−function :: Type -> Type -> Type
212−function t1 = TypeApp (TypeApp tyFunction t1)
213−
214−-- |
215−-- The primitive types in the external javascript environment with their associated kinds.
216−--
217−primTypes :: M.Map (Qualified ProperName) (Kind, TypeKind)
218−primTypes = M.fromList [ (primName "Function" , (FunKind Star (FunKind Star Star), ExternData))
219− , (primName "Array" , (FunKind Star Star, ExternData))
220− , (primName "Object" , (FunKind (Row Star) Star, ExternData))
221− , (primName "String" , (Star, ExternData))
222− , (primName "Char" , (Star, ExternData))
223− , (primName "Number" , (Star, ExternData))
224− , (primName "Int" , (Star, ExternData))
225− , (primName "Boolean" , (Star, ExternData)) ]
226−
227−-- |
228−-- Finds information about data constructors from the current environment.
229−--
230−lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type, [Ident])
231−lookupConstructor env ctor =
232− fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors env
233−
234−-- |
235−-- Checks whether a data constructor is for a newtype.
236−--
237−isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
238−isNewtypeConstructor e ctor = case lookupConstructor e ctor of
239− (Newtype, _, _, _) -> True
240− (Data, _, _, _) -> False
241−
242−-- |
243−-- Finds information about values from the current environment.
244−--
245−lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)
246−lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env
247−lookupValue _ _ = Nothing
src/Language/PureScript/Errors.hsdeleted−793
@@ -1,793 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Error
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE MultiParamTypeClasses #-}
18−
19−module Language.PureScript.Errors where
20−
21−import Data.Either (lefts, rights)
22−import Data.List (intercalate)
23−import Data.Function (on)
24−import Data.Monoid
25−import Data.Foldable (fold, foldMap)
26−
27−import qualified Data.Map as M
28−
29−import Control.Monad
30−import Control.Monad.Unify
31−import Control.Monad.Writer
32−import Control.Monad.Error.Class (MonadError(..))
33−import Control.Applicative ((<$>), (<*>), Applicative, pure)
34−import Control.Monad.Trans.State.Lazy
35−import Control.Arrow(first)
36−
37−import Language.PureScript.AST
38−import Language.PureScript.Environment (isObject)
39−import Language.PureScript.Pretty
40−import Language.PureScript.Types
41−import Language.PureScript.Names
42−import Language.PureScript.Kinds
43−import Language.PureScript.TypeClassDictionaries
44−
45−import qualified Text.PrettyPrint.Boxes as Box
46−
47−import qualified Text.Parsec as P
48−
49−-- |
50−-- A type of error messages
51−--
52−data SimpleErrorMessage
53− = ErrorParsingExterns P.ParseError
54− | ErrorParsingFFIModule FilePath
55− | ErrorParsingPrelude P.ParseError
56− | ErrorParsingModule P.ParseError
57− | MissingFFIModule ModuleName
58− | MultipleFFIModules ModuleName [FilePath]
59− | UnnecessaryFFIModule ModuleName FilePath
60− | InvalidExternsFile FilePath
61− | CannotGetFileInfo FilePath
62− | CannotReadFile FilePath
63− | CannotWriteFile FilePath
64− | InfiniteType Type
65− | InfiniteKind Kind
66− | CannotReorderOperators
67− | MultipleFixities Ident
68− | OrphanTypeDeclaration Ident
69− | OrphanFixityDeclaration String
70− | RedefinedModule ModuleName
71− | RedefinedIdent Ident
72− | OverlappingNamesInLet
73− | UnknownModule ModuleName
74− | UnknownType (Qualified ProperName)
75− | UnknownTypeClass (Qualified ProperName)
76− | UnknownValue (Qualified Ident)
77− | UnknownDataConstructor (Qualified ProperName) (Maybe (Qualified ProperName))
78− | UnknownTypeConstructor (Qualified ProperName)
79− | ConflictingImport String ModuleName
80− | ConflictingImports String ModuleName ModuleName
81− | ConflictingTypeDecls ProperName
82− | ConflictingCtorDecls ProperName
83− | TypeConflictsWithClass ProperName
84− | CtorConflictsWithClass ProperName
85− | ClassConflictsWithType ProperName
86− | ClassConflictsWithCtor ProperName
87− | DuplicateClassExport ProperName
88− | DuplicateValueExport Ident
89− | DuplicateTypeArgument String
90− | InvalidDoBind
91− | InvalidDoLet
92− | CycleInDeclaration Ident
93− | CycleInTypeSynonym (Maybe ProperName)
94− | CycleInModules [ModuleName]
95− | NameIsUndefined Ident
96− | NameNotInScope Ident
97− | UndefinedTypeVariable ProperName
98− | PartiallyAppliedSynonym (Qualified ProperName)
99− | EscapedSkolem (Maybe Expr)
100− | UnspecifiedSkolemScope
101− | TypesDoNotUnify Type Type
102− | KindsDoNotUnify Kind Kind
103− | ConstrainedTypeUnified Type Type
104− | OverlappingInstances (Qualified ProperName) [Type] [DictionaryValue]
105− | NoInstanceFound (Qualified ProperName) [Type]
106− | DuplicateLabel String (Maybe Expr)
107− | DuplicateValueDeclaration Ident
108− | ArgListLengthsDiffer Ident
109− | OverlappingArgNames (Maybe Ident)
110− | MissingClassMember Ident
111− | ExpectedType Kind
112− | IncorrectConstructorArity (Qualified ProperName)
113− | SubsumptionCheckFailed
114− | ExprDoesNotHaveType Expr Type
115− | PropertyIsMissing String Type
116− | CannotApplyFunction Type Expr
117− | TypeSynonymInstance
118− | InvalidNewtype
119− | InvalidInstanceHead Type
120− | TransitiveExportError DeclarationRef [DeclarationRef]
121− | ShadowedName Ident
122− | WildcardInferredType Type
123− | PreludeNotPresent
124− deriving (Show)
125−
126−-- |
127−-- Wrapper of simpler errors
128−--
129−data ErrorMessage
130− = NotYetDefined [Ident] ErrorMessage
131− | ErrorUnifyingTypes Type Type ErrorMessage
132− | ErrorInExpression Expr ErrorMessage
133− | ErrorInModule ModuleName ErrorMessage
134− | ErrorInInstance (Qualified ProperName) [Type] ErrorMessage
135− | ErrorInSubsumption Type Type ErrorMessage
136− | ErrorCheckingType Expr Type ErrorMessage
137− | ErrorCheckingKind Type ErrorMessage
138− | ErrorInferringType Expr ErrorMessage
139− | ErrorInApplication Expr Type Expr ErrorMessage
140− | ErrorInDataConstructor ProperName ErrorMessage
141− | ErrorInTypeConstructor ProperName ErrorMessage
142− | ErrorInBindingGroup [Ident] ErrorMessage
143− | ErrorInDataBindingGroup ErrorMessage
144− | ErrorInTypeSynonym ProperName ErrorMessage
145− | ErrorInValueDeclaration Ident ErrorMessage
146− | ErrorInForeignImport Ident ErrorMessage
147− | PositionedError SourceSpan ErrorMessage
148− | SimpleErrorWrapper SimpleErrorMessage
149− deriving (Show)
150−
151−instance UnificationError Type ErrorMessage where
152− occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t
153−
154−instance UnificationError Kind ErrorMessage where
155− occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k
156−
157−-- |
158−-- Get the error code for a particular error type
159−--
160−errorCode :: ErrorMessage -> String
161−errorCode em = case unwrapErrorMessage em of
162− (ErrorParsingExterns _) -> "ErrorParsingExterns"
163− (ErrorParsingFFIModule _) -> "ErrorParsingFFIModule"
164− (ErrorParsingPrelude _) -> "ErrorParsingPrelude"
165− (ErrorParsingModule _) -> "ErrorParsingModule"
166− MissingFFIModule{} -> "MissingFFIModule"
167− MultipleFFIModules{} -> "MultipleFFIModules"
168− UnnecessaryFFIModule{} -> "UnnecessaryFFIModule"
169− (InvalidExternsFile _) -> "InvalidExternsFile"
170− (CannotGetFileInfo _) -> "CannotGetFileInfo"
171− (CannotReadFile _) -> "CannotReadFile"
172− (CannotWriteFile _) -> "CannotWriteFile"
173− (InfiniteType _) -> "InfiniteType"
174− (InfiniteKind _) -> "InfiniteKind"
175− CannotReorderOperators -> "CannotReorderOperators"
176− (MultipleFixities _) -> "MultipleFixities"
177− (OrphanTypeDeclaration _) -> "OrphanTypeDeclaration"
178− (OrphanFixityDeclaration _) -> "OrphanFixityDeclaration"
179− (RedefinedModule _) -> "RedefinedModule"
180− (RedefinedIdent _) -> "RedefinedIdent"
181− OverlappingNamesInLet -> "OverlappingNamesInLet"
182− (UnknownModule _) -> "UnknownModule"
183− (UnknownType _) -> "UnknownType"
184− (UnknownTypeClass _) -> "UnknownTypeClass"
185− (UnknownValue _) -> "UnknownValue"
186− (UnknownDataConstructor _ _) -> "UnknownDataConstructor"
187− (UnknownTypeConstructor _) -> "UnknownTypeConstructor"
188− (ConflictingImport _ _) -> "ConflictingImport"
189− (ConflictingImports _ _ _) -> "ConflictingImports"
190− (ConflictingTypeDecls _) -> "ConflictingTypeDecls"
191− (ConflictingCtorDecls _) -> "ConflictingCtorDecls"
192− (TypeConflictsWithClass _) -> "TypeConflictsWithClass"
193− (CtorConflictsWithClass _) -> "CtorConflictsWithClass"
194− (ClassConflictsWithType _) -> "ClassConflictsWithType"
195− (ClassConflictsWithCtor _) -> "ClassConflictsWithCtor"
196− (DuplicateClassExport _) -> "DuplicateClassExport"
197− (DuplicateValueExport _) -> "DuplicateValueExport"
198− (DuplicateTypeArgument _) -> "DuplicateTypeArgument"
199− InvalidDoBind -> "InvalidDoBind"
200− InvalidDoLet -> "InvalidDoLet"
201− (CycleInDeclaration _) -> "CycleInDeclaration"
202− (CycleInTypeSynonym _) -> "CycleInTypeSynonym"
203− (CycleInModules _) -> "CycleInModules"
204− (NameIsUndefined _) -> "NameIsUndefined"
205− (NameNotInScope _) -> "NameNotInScope"
206− (UndefinedTypeVariable _) -> "UndefinedTypeVariable"
207− (PartiallyAppliedSynonym _) -> "PartiallyAppliedSynonym"
208− (EscapedSkolem _) -> "EscapedSkolem"
209− UnspecifiedSkolemScope -> "UnspecifiedSkolemScope"
210− (TypesDoNotUnify _ _) -> "TypesDoNotUnify"
211− (KindsDoNotUnify _ _) -> "KindsDoNotUnify"
212− (ConstrainedTypeUnified _ _) -> "ConstrainedTypeUnified"
213− (OverlappingInstances _ _ _) -> "OverlappingInstances"
214− (NoInstanceFound _ _) -> "NoInstanceFound"
215− (DuplicateLabel _ _) -> "DuplicateLabel"
216− (DuplicateValueDeclaration _) -> "DuplicateValueDeclaration"
217− (ArgListLengthsDiffer _) -> "ArgListLengthsDiffer"
218− (OverlappingArgNames _) -> "OverlappingArgNames"
219− (MissingClassMember _) -> "MissingClassMember"
220− (ExpectedType _) -> "ExpectedType"
221− (IncorrectConstructorArity _) -> "IncorrectConstructorArity"
222− SubsumptionCheckFailed -> "SubsumptionCheckFailed"
223− (ExprDoesNotHaveType _ _) -> "ExprDoesNotHaveType"
224− (PropertyIsMissing _ _) -> "PropertyIsMissing"
225− (CannotApplyFunction _ _) -> "CannotApplyFunction"
226− TypeSynonymInstance -> "TypeSynonymInstance"
227− InvalidNewtype -> "InvalidNewtype"
228− (InvalidInstanceHead _) -> "InvalidInstanceHead"
229− (TransitiveExportError _ _) -> "TransitiveExportError"
230− (ShadowedName _) -> "ShadowedName"
231− (WildcardInferredType _) -> "WildcardInferredType"
232− PreludeNotPresent -> "PreludeNotPresent"
233−
234−-- |
235−-- A stack trace for an error
236−--
237−newtype MultipleErrors = MultipleErrors
238− { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)
239−
240−instance UnificationError Type MultipleErrors where
241− occursCheckFailed = occursCheckFailed
242−
243−instance UnificationError Kind MultipleErrors where
244− occursCheckFailed = occursCheckFailed
245−
246−-- | Check whether a collection of errors is empty or not.
247−nonEmpty :: MultipleErrors -> Bool
248−nonEmpty = not . null . runMultipleErrors
249−
250−-- |
251−-- Create an error set from a single simple error message
252−--
253−errorMessage :: SimpleErrorMessage -> MultipleErrors
254−errorMessage err = MultipleErrors [SimpleErrorWrapper err]
255−
256−
257−-- |
258−-- Create an error set from a single error message
259−--
260−singleError :: ErrorMessage -> MultipleErrors
261−singleError = MultipleErrors . pure
262−
263−-- |
264−-- Lift a function on ErrorMessage to a function on MultipleErrors
265−--
266−onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors
267−onErrorMessages f = MultipleErrors . map f . runMultipleErrors
268−
269−-- | The various types of things which might need to be relabelled in errors messages.
270−data LabelType = TypeLabel | SkolemLabel String deriving (Show, Eq, Ord)
271−
272−-- | A map from rigid type variable name/unknown variable pairs to new variables.
273−type UnknownMap = M.Map (LabelType, Unknown) Unknown
274−
275−-- |
276−-- Extract nested error messages from wrapper errors
277−--
278−unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage
279−unwrapErrorMessage em = case em of
280− (ErrorCheckingKind _ err) -> unwrapErrorMessage err
281− (ErrorCheckingType _ _ err) -> unwrapErrorMessage err
282− (ErrorInApplication _ _ _ err) -> unwrapErrorMessage err
283− (ErrorInBindingGroup _ err) -> unwrapErrorMessage err
284− (ErrorInDataBindingGroup err) -> unwrapErrorMessage err
285− (ErrorInDataConstructor _ err) -> unwrapErrorMessage err
286− (ErrorInExpression _ err) -> unwrapErrorMessage err
287− (ErrorInForeignImport _ err) -> unwrapErrorMessage err
288− (ErrorInInstance _ _ err) -> unwrapErrorMessage err
289− (ErrorInModule _ err) -> unwrapErrorMessage err
290− (ErrorInSubsumption _ _ err) -> unwrapErrorMessage err
291− (ErrorInTypeConstructor _ err) -> unwrapErrorMessage err
292− (ErrorInTypeSynonym _ err) -> unwrapErrorMessage err
293− (ErrorInValueDeclaration _ err) -> unwrapErrorMessage err
294− (ErrorInferringType _ err) -> unwrapErrorMessage err
295− (ErrorUnifyingTypes _ _ err) -> unwrapErrorMessage err
296− (NotYetDefined _ err) -> unwrapErrorMessage err
297− (PositionedError _ err) -> unwrapErrorMessage err
298− (SimpleErrorWrapper sem) -> sem
299−
300−replaceUnknowns :: Type -> State UnknownMap Type
301−replaceUnknowns = everywhereOnTypesM replaceTypes
302− where
303− lookupTable :: (LabelType, Unknown) -> UnknownMap -> (Unknown, UnknownMap)
304− lookupTable x m = case M.lookup x m of
305− Nothing -> let i = length (filter (on (==) fst x) (M.keys m)) in (i, M.insert x i m)
306− Just i -> (i, m)
307−
308− replaceTypes :: Type -> State UnknownMap Type
309− replaceTypes (TUnknown u) = state $ first TUnknown . lookupTable (TypeLabel, u)
310− replaceTypes (Skolem name s sko) = state $ first (flip (Skolem name) sko) . lookupTable (SkolemLabel name, s)
311− replaceTypes other = return other
312−
313−onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
314−onTypesInErrorMessageM f = g
315− where
316− gSimple (InfiniteType t) = InfiniteType <$> (f t)
317− gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)
318− gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)
319− gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)
320− gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)
321− gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)
322− gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
323− gSimple other = pure other
324− g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> (f t1) <*> (f t2) <*> (g em)
325− g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)
326− g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)
327− g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em
328− g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)
329− g (NotYetDefined x e) = NotYetDefined x <$> (g e)
330− g (ErrorInExpression x e) = ErrorInExpression x <$> (g e)
331− g (ErrorInModule x e) = ErrorInModule x <$> (g e)
332− g (ErrorInInstance x y e) = ErrorInInstance x y <$> (g e)
333− g (ErrorInferringType x e) = ErrorInferringType x <$> (g e)
334− g (ErrorInDataConstructor x e) = ErrorInDataConstructor x <$> (g e)
335− g (ErrorInTypeConstructor x e) = ErrorInTypeConstructor x <$> (g e)
336− g (ErrorInBindingGroup x e) = ErrorInBindingGroup x <$> (g e)
337− g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> (g e)
338− g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> (g e)
339− g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)
340− g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)
341− g (PositionedError x e) = PositionedError x <$> (g e)
342− g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem
343−
344−-- |
345−-- Pretty print a single error, simplifying if necessary
346−--
347−prettyPrintSingleError :: Bool -> ErrorMessage -> State UnknownMap Box.Box
348−prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
349− where
350− -- |
351− -- Pretty print an ErrorMessage
352− --
353− prettyPrintErrorMessage :: ErrorMessage -> Box.Box
354− prettyPrintErrorMessage em =
355− paras $
356− go em:suggestions em ++
357− [line $ "See " ++ wikiUri ++ " for more information, or to contribute content related to this error."]
358− where
359− wikiUri :: String
360− wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
361−
362− go :: ErrorMessage -> Box.Box
363− goSimple (CannotGetFileInfo path) =
364− paras [ line "Unable to read file info: "
365− , indent . line $ path
366− ]
367− goSimple (CannotReadFile path) =
368− paras [ line "Unable to read file: "
369− , indent . line $ path
370− ]
371− goSimple (CannotWriteFile path) =
372− paras [ line "Unable to write file: "
373− , indent . line $ path
374− ]
375− goSimple (ErrorParsingExterns err) =
376− paras [ line "Error parsing externs files: "
377− , indent . line . show $ err
378− ]
379− goSimple (ErrorParsingFFIModule path) =
380− paras [ line "Unable to parse module from FFI file: "
381− , indent . line $ path
382− ]
383− goSimple (ErrorParsingModule err) =
384− paras [ line "Unable to parse module: "
385− , indent . line . show $ err
386− ]
387− goSimple (MissingFFIModule mn) =
388− line $ "Missing FFI implementations for module " ++ show mn
389− goSimple (UnnecessaryFFIModule mn path) =
390− paras [ line $ "Unnecessary FFI implementations have been provided for module " ++ show mn ++ ": "
391− , indent . line $ path
392− ]
393− goSimple (MultipleFFIModules mn paths) =
394− paras $ [ line $ "Multiple FFI implementations have been provided for module " ++ show mn ++ ": " ]
395− ++ map (indent . line) paths
396− goSimple (ErrorParsingPrelude err) =
397− paras [ line "Error parsing prelude: "
398− , indent . line . show $ err
399− ]
400− goSimple (InvalidExternsFile path) =
401− paras [ line "Externs file is invalid: "
402− , indent . line $ path
403− ]
404− goSimple InvalidDoBind =
405− line "Bind statement cannot be the last statement in a do block"
406− goSimple InvalidDoLet =
407− line "Let statement cannot be the last statement in a do block"
408− goSimple CannotReorderOperators =
409− line "Unable to reorder operators"
410− goSimple UnspecifiedSkolemScope =
411− line "Skolem variable scope is unspecified"
412− goSimple OverlappingNamesInLet =
413− line "Overlapping names in let binding."
414− goSimple (InfiniteType ty) =
415− paras [ line "Infinite type detected: "
416− , indent $ line $ prettyPrintType ty
417− ]
418− goSimple (InfiniteKind ki) =
419− paras [ line "Infinite kind detected: "
420− , indent $ line $ prettyPrintKind ki
421− ]
422− goSimple (MultipleFixities name) =
423− line $ "Multiple fixity declarations for " ++ show name
424− goSimple (OrphanTypeDeclaration nm) =
425− line $ "Orphan type declaration for " ++ show nm
426− goSimple (OrphanFixityDeclaration op) =
427− line $ "Orphan fixity declaration for " ++ show op
428− goSimple (RedefinedModule name) =
429− line $ "Module " ++ show name ++ " has been defined multiple times"
430− goSimple (RedefinedIdent name) =
431− line $ "Name " ++ show name ++ " has been defined multiple times"
432− goSimple (UnknownModule mn) =
433− line $ "Unknown module " ++ show mn
434− goSimple (UnknownType name) =
435− line $ "Unknown type " ++ show name
436− goSimple (UnknownTypeClass name) =
437− line $ "Unknown type class " ++ show name
438− goSimple (UnknownValue name) =
439− line $ "Unknown value " ++ show name
440− goSimple (UnknownTypeConstructor name) =
441− line $ "Unknown type constructor " ++ show name
442− goSimple (UnknownDataConstructor dc tc) =
443− line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc
444− goSimple (ConflictingImport nm mn) =
445− line $ "Cannot declare `" ++ nm ++ "` since another declaration of that name was imported from `" ++ show mn ++ "`"
446− goSimple (ConflictingImports nm m1 m2) =
447− line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2
448− goSimple (ConflictingTypeDecls nm) =
449− line $ "Conflicting type declarations for " ++ show nm
450− goSimple (ConflictingCtorDecls nm) =
451− line $ "Conflicting data constructor declarations for " ++ show nm
452− goSimple (TypeConflictsWithClass nm) =
453− line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"
454− goSimple (CtorConflictsWithClass nm) =
455− line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"
456− goSimple (ClassConflictsWithType nm) =
457− line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"
458− goSimple (ClassConflictsWithCtor nm) =
459− line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"
460− goSimple (DuplicateClassExport nm) =
461− line $ "Duplicate export declaration for type class " ++ show nm
462− goSimple (DuplicateValueExport nm) =
463− line $ "Duplicate export declaration for value " ++ show nm
464− goSimple (CycleInDeclaration nm) =
465− line $ "Cycle in declaration of " ++ show nm
466− goSimple (CycleInModules mns) =
467− line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)
468− goSimple (CycleInTypeSynonym pn) =
469− line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn
470− goSimple (NameIsUndefined ident) =
471− line $ show ident ++ " is undefined"
472− goSimple (NameNotInScope ident) =
473− line $ show ident ++ " may not be defined in the current scope"
474− goSimple (UndefinedTypeVariable name) =
475− line $ "Type variable " ++ show name ++ " is undefined"
476− goSimple (PartiallyAppliedSynonym name) =
477− line $ "Partially applied type synonym " ++ show name
478− goSimple (EscapedSkolem binding) =
479− paras $ [ line "Rigid/skolem type variable has escaped." ]
480− <> foldMap (\expr -> [ line "Relevant expression: "
481− , indent $ line $ prettyPrintValue expr
482− ]) binding
483− goSimple (TypesDoNotUnify t1 t2)
484− = paras [ line "Cannot unify type"
485− , indent $ line $ prettyPrintType t1
486− , line "with type"
487− , indent $ line $ prettyPrintType t2
488− ]
489− goSimple (KindsDoNotUnify k1 k2) =
490− paras [ line "Cannot unify kind"
491− , indent $ line $ prettyPrintKind k1
492− , line "with kind"
493− , indent $ line $ prettyPrintKind k2
494− ]
495− goSimple (ConstrainedTypeUnified t1 t2) =
496− paras [ line "Cannot unify constrained type"
497− , indent $ line $ prettyPrintType t1
498− , line "with type"
499− , indent $ line $ prettyPrintType t2
500− ]
501− goSimple (OverlappingInstances nm ts ds) =
502− paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
503− , paras $ map prettyPrintDictionaryValue ds
504− ]
505− goSimple (NoInstanceFound nm ts) =
506− line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)
507− goSimple (DuplicateLabel l expr) =
508− paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
509− <> foldMap (\expr' -> [ line "Relevant expression: "
510− , indent $ line $ prettyPrintValue expr'
511− ]) expr
512− goSimple (DuplicateTypeArgument name) =
513− line $ "Duplicate type argument " ++ show name
514− goSimple (DuplicateValueDeclaration nm) =
515− line $ "Duplicate value declaration for " ++ show nm
516− goSimple (ArgListLengthsDiffer ident) =
517− line $ "Argument list lengths differ in declaration " ++ show ident
518− goSimple (OverlappingArgNames ident) =
519− line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident
520− goSimple (MissingClassMember ident) =
521− line $ "Member " ++ show ident ++ " has not been implemented"
522− goSimple (ExpectedType kind) =
523− line $ "Expected type of kind *, was " ++ prettyPrintKind kind
524− goSimple (IncorrectConstructorArity nm) =
525− line $ "Wrong number of arguments to constructor " ++ show nm
526− goSimple SubsumptionCheckFailed = line $ "Unable to check type subsumption"
527− goSimple (ExprDoesNotHaveType expr ty) =
528− paras [ line "Expression"
529− , indent $ line $ prettyPrintValue expr
530− , line "does not have type"
531− , indent $ line $ prettyPrintType ty
532− ]
533− goSimple (PropertyIsMissing prop row) =
534− line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop
535− goSimple (CannotApplyFunction fn arg) =
536− paras [ line "Cannot apply function of type"
537− , indent $ line $ prettyPrintType fn
538− , line "to argument"
539− , indent $ line $ prettyPrintValue arg
540− ]
541− goSimple TypeSynonymInstance =
542− line "Type synonym instances are disallowed"
543− goSimple InvalidNewtype =
544− line "Newtypes must define a single constructor with a single argument"
545− goSimple (InvalidInstanceHead ty) =
546− paras [ line "Invalid type in class instance head:"
547− , indent $ line $ prettyPrintType ty
548− ]
549− goSimple (TransitiveExportError x ys) =
550− paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
551− : map (line . prettyPrintExport) ys
552− goSimple (ShadowedName nm) =
553− line $ "Name '" ++ show nm ++ "' was shadowed."
554− goSimple (WildcardInferredType ty) =
555− line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty
556− goSimple PreludeNotPresent =
557− paras [ line $ "There is no Prelude module loaded, and the --no-prelude option was not specified."
558− , line $ "You probably need to install the Prelude and other dependencies using Bower."
559− ]
560− go (NotYetDefined names err) =
561− paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
562− , indent $ go err
563− ]
564− go (ErrorUnifyingTypes t1 t2 err) =
565− paras [ line "Error unifying type "
566− , indent $ line $ prettyPrintType t1
567− , line "with type"
568− , indent $ line $ prettyPrintType t2
569− , go err
570− ]
571− go (ErrorInExpression expr err) =
572− paras [ line "Error in expression:"
573− , indent $ line $ prettyPrintValue expr
574− , go err
575− ]
576− go (ErrorInModule mn err) =
577− paras [ line $ "Error in module " ++ show mn ++ ":"
578− , go err
579− ]
580− go (ErrorInSubsumption t1 t2 err) =
581− paras [ line "Error checking that type "
582− , indent $ line $ prettyPrintType t1
583− , line "subsumes type"
584− , indent $ line $ prettyPrintType t2
585− , go err
586− ]
587− go (ErrorInInstance name ts err) =
588− paras [ line $ "Error in type class instance " ++ show name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
589− , go err
590− ]
591− go (ErrorCheckingKind ty err) =
592− paras [ line "Error checking kind of type "
593− , indent $ line $ prettyPrintType ty
594− , go err
595− ]
596− go (ErrorInferringType expr err) =
597− paras [ line "Error inferring type of value "
598− , indent $ line $ prettyPrintValue expr
599− , go err
600− ]
601− go (ErrorCheckingType expr ty err) =
602− paras [ line "Error checking that value "
603− , indent $ line $ prettyPrintValue expr
604− , line "has type"
605− , indent $ line $ prettyPrintType ty
606− , go err
607− ]
608− go (ErrorInApplication f t a err) =
609− paras [ line "Error applying function"
610− , indent $ line $ prettyPrintValue f
611− , line "of type"
612− , indent $ line $ prettyPrintType t
613− , line "to argument"
614− , indent $ line $ prettyPrintValue a
615− , go err
616− ]
617− go (ErrorInDataConstructor nm err) =
618− paras [ line $ "Error in data constructor " ++ show nm ++ ":"
619− , go err
620− ]
621− go (ErrorInTypeConstructor nm err) =
622− paras [ line $ "Error in type constructor " ++ show nm ++ ":"
623− , go err
624− ]
625− go (ErrorInBindingGroup nms err) =
626− paras [ line $ "Error in binding group " ++ intercalate ", " (map show nms) ++ ":"
627− , go err
628− ]
629− go (ErrorInDataBindingGroup err) =
630− paras [ line $ "Error in data binding group:"
631− , go err
632− ]
633− go (ErrorInTypeSynonym name err) =
634− paras [ line $ "Error in type synonym " ++ show name ++ ":"
635− , go err
636− ]
637− go (ErrorInValueDeclaration n err) =
638− paras [ line $ "Error in value declaration " ++ show n ++ ":"
639− , go err
640− ]
641− go (ErrorInForeignImport nm err) =
642− paras [ line $ "Error in foreign import " ++ show nm ++ ":"
643− , go err
644− ]
645− go (PositionedError srcSpan err) =
646− paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"
647− , indent $ go err
648− ]
649− go (SimpleErrorWrapper sem) = goSimple sem
650−
651− line :: String -> Box.Box
652− line = Box.text
653−
654− suggestions :: ErrorMessage -> [Box.Box]
655− suggestions = suggestions' . unwrapErrorMessage
656− where
657− suggestions' (ConflictingImport nm im) = [ line $ "Possible fix: hide `" ++ nm ++ "` when importing `" ++ show im ++ "`:"
658− , indent . line $ "import " ++ show im ++ " hiding (" ++ nm ++ ")"
659− ]
660− suggestions' (TypesDoNotUnify t1 t2)
661− | any isObject [t1, t2] = [line "Note that function composition in PureScript is defined using `(<<<)`"]
662− | otherwise = []
663− suggestions' _ = []
664−
665− paras :: [Box.Box] -> Box.Box
666− paras = Box.vcat Box.left
667−
668− indent :: Box.Box -> Box.Box
669− indent = Box.moveRight 2
670−
671− -- |
672− -- Render a DictionaryValue fit for human consumption in error messages
673− --
674− prettyPrintDictionaryValue :: DictionaryValue -> Box.Box
675− prettyPrintDictionaryValue (LocalDictionaryValue _) = line "Dictionary in scope"
676− prettyPrintDictionaryValue (GlobalDictionaryValue nm) = line (show nm)
677− prettyPrintDictionaryValue (DependentDictionaryValue nm args) = paras [ line $ (show nm) ++ " via"
678− , indent $ paras $ map prettyPrintDictionaryValue args
679− ]
680− prettyPrintDictionaryValue (SubclassDictionaryValue sup nm _) = paras [ line $ (show nm) ++ " via superclass"
681− , indent $ prettyPrintDictionaryValue sup
682− ]
683−
684− -- |
685− -- Pretty print and export declaration
686− --
687− prettyPrintExport :: DeclarationRef -> String
688− prettyPrintExport (TypeRef pn _) = show pn
689− prettyPrintExport (ValueRef ident) = show ident
690− prettyPrintExport (TypeClassRef pn) = show pn
691− prettyPrintExport (TypeInstanceRef ident) = show ident
692− prettyPrintExport (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
693−
694− -- |
695− -- Simplify an error message
696− --
697− simplifyErrorMessage :: ErrorMessage -> ErrorMessage
698− simplifyErrorMessage = unwrap Nothing
699− where
700− unwrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
701− unwrap pos (ErrorInExpression _ err) = unwrap pos err
702− unwrap pos (ErrorInInstance name ts err) = ErrorInInstance name ts (unwrap pos err)
703− unwrap pos (ErrorInSubsumption t1 t2 err) = ErrorInSubsumption t1 t2 (unwrap pos err)
704− unwrap pos (ErrorUnifyingTypes _ _ err) = unwrap pos err
705− unwrap pos (ErrorInferringType _ err) = unwrap pos err
706− unwrap pos (ErrorCheckingType _ _ err) = unwrap pos err
707− unwrap pos (ErrorCheckingKind ty err) = ErrorCheckingKind ty (unwrap pos err)
708− unwrap pos (ErrorInModule mn err) = ErrorInModule mn (unwrap pos err)
709− unwrap pos (ErrorInApplication _ _ _ err) = unwrap pos err
710− unwrap pos (ErrorInDataConstructor nm err) = ErrorInDataConstructor nm (unwrap pos err)
711− unwrap pos (ErrorInTypeConstructor nm err) = ErrorInTypeConstructor nm (unwrap pos err)
712− unwrap pos (ErrorInBindingGroup nms err) = ErrorInBindingGroup nms (unwrap pos err)
713− unwrap pos (ErrorInDataBindingGroup err) = ErrorInDataBindingGroup (unwrap pos err)
714− unwrap pos (ErrorInTypeSynonym nm err) = ErrorInTypeSynonym nm (unwrap pos err)
715− unwrap pos (ErrorInValueDeclaration nm err) = ErrorInValueDeclaration nm (unwrap pos err)
716− unwrap pos (ErrorInForeignImport nm err) = ErrorInForeignImport nm (unwrap pos err)
717− unwrap pos (NotYetDefined ns err) = NotYetDefined ns (unwrap pos err)
718− unwrap _ (PositionedError pos err) = unwrap (Just pos) err
719− unwrap pos other = wrap pos other
720−
721− wrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
722− wrap Nothing = id
723− wrap (Just pos) = PositionedError pos
724−
725−
726−-- |
727−-- Pretty print multiple errors
728−--
729−prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String
730−prettyPrintMultipleErrors full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Error:" "Multiple errors:" full
731−
732−-- |
733−-- Pretty print multiple warnings
734−--
735−prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String
736−prettyPrintMultipleWarnings full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Warning:" "Multiple warnings:" full
737−
738−prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> State UnknownMap String
739−prettyPrintMultipleErrorsWith intro _ full (MultipleErrors [e]) = do
740− result <- prettyPrintSingleError full e
741− return $ renderBox $
742− Box.vcat Box.left [ Box.text intro
743− , result
744− ]
745−prettyPrintMultipleErrorsWith _ intro full (MultipleErrors es) = do
746− result <- forM es $ (liftM $ Box.moveRight 2) . prettyPrintSingleError full
747− return $ renderBox $
748− Box.vcat Box.left [ Box.text intro
749− , Box.vsep 1 Box.left result
750− ]
751−
752−renderBox :: Box.Box -> String
753−renderBox = unlines . map trimEnd . lines . Box.render
754− where
755− trimEnd = reverse . dropWhile (== ' ') . reverse
756−
757−-- |
758−-- Interpret multiple errors and warnings in a monad supporting errors and warnings
759−--
760−interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a
761−interpretMultipleErrorsAndWarnings (err, ws) = do
762− tell ws
763− either throwError return $ err
764−
765−-- |
766−-- Rethrow an error with a more detailed error message in the case of failure
767−--
768−rethrow :: (MonadError e m) => (e -> e) -> m a -> m a
769−rethrow f = flip catchError $ \e -> throwError (f e)
770−
771−-- |
772−-- Rethrow an error with source position information
773−--
774−rethrowWithPosition :: (MonadError MultipleErrors m) => SourceSpan -> m a -> m a
775−rethrowWithPosition pos = rethrow (onErrorMessages withPosition)
776− where
777− withPosition :: ErrorMessage -> ErrorMessage
778− withPosition (PositionedError _ err) = withPosition err
779− withPosition err = PositionedError pos err
780−
781−-- |
782−-- Collect errors in in parallel
783−--
784−parU :: (MonadError MultipleErrors m, Functor m) => [a] -> (a -> m b) -> m [b]
785−parU xs f = forM xs (withError . f) >>= collectErrors
786− where
787− withError :: (MonadError MultipleErrors m, Functor m) => m a -> m (Either MultipleErrors a)
788− withError u = catchError (Right <$> u) (return . Left)
789−
790− collectErrors :: (MonadError MultipleErrors m, Functor m) => [Either MultipleErrors a] -> m [a]
791− collectErrors es = case lefts es of
792− [] -> return $ rights es
793− errs -> throwError $ fold errs
src/Language/PureScript/Kinds.hsdeleted−68
@@ -1,68 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Kinds
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−
17−module Language.PureScript.Kinds where
18−
19−import Data.Data
20−
21−import Control.Applicative
22−import Control.Monad.Unify (Unknown)
23−
24−-- |
25−-- The data type of kinds
26−--
27−data Kind
28− -- |
29− -- Unification variable of type Kind
30− --
31− = KUnknown Unknown
32− -- |
33− -- The kind of types
34− --
35− | Star
36− -- |
37− -- The kind of effects
38− --
39− | Bang
40− -- |
41− -- Kinds for labelled, unordered rows without duplicates
42− --
43− | Row Kind
44− -- |
45− -- Function kinds
46− --
47− | FunKind Kind Kind deriving (Show, Eq, Data, Typeable)
48−
49−everywhereOnKinds :: (Kind -> Kind) -> Kind -> Kind
50−everywhereOnKinds f = go
51− where
52− go (Row k1) = f (Row (go k1))
53− go (FunKind k1 k2) = f (FunKind (go k1) (go k2))
54− go other = f other
55−
56−everywhereOnKindsM :: (Functor m, Applicative m, Monad m) => (Kind -> m Kind) -> Kind -> m Kind
57−everywhereOnKindsM f = go
58− where
59− go (Row k1) = (Row <$> go k1) >>= f
60− go (FunKind k1 k2) = (FunKind <$> go k1 <*> go k2) >>= f
61− go other = f other
62−
63−everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r
64−everythingOnKinds (<>) f = go
65− where
66− go k@(Row k1) = f k <> go k1
67− go k@(FunKind k1 k2) = f k <> go k1 <> go k2
68− go other = f other
src/Language/PureScript/Linter.hsdeleted−73
@@ -1,73 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Linter
4−-- Copyright : (c) Copyright 2015 PureScript
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | This module implements a simple linting pass on the PureScript AST.
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−
19−module Language.PureScript.Linter (lint) where
20−
21−import Data.List (mapAccumL, nub)
22−import Data.Maybe (mapMaybe)
23−import Data.Monoid
24−
25−import qualified Data.Set as S
26−
27−import Control.Applicative
28−import Control.Monad.Writer.Class
29−
30−import Language.PureScript.AST
31−import Language.PureScript.Names
32−import Language.PureScript.Errors
33−
34−-- | Lint the PureScript AST.
35−-- |
36−-- | Right now, this pass only performs a shadowing check.
37−lint :: forall m. (Applicative m, MonadWriter MultipleErrors m) => Module -> m ()
38−lint (Module _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_ lintDeclaration ds
39− where
40− moduleNames :: S.Set Ident
41− moduleNames = S.fromList (nub (mapMaybe getDeclIdent ds))
42−
43− getDeclIdent :: Declaration -> Maybe Ident
44− getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d
45− getDeclIdent (ValueDeclaration ident _ _ _) = Just ident
46− getDeclIdent (ExternDeclaration ident _) = Just ident
47− getDeclIdent (ExternInstanceDeclaration ident _ _ _) = Just ident
48− getDeclIdent (TypeInstanceDeclaration ident _ _ _ _) = Just ident
49− getDeclIdent (BindingGroupDeclaration _) = error "lint: binding groups should not be desugared yet."
50− getDeclIdent _ = Nothing
51−
52− lintDeclaration :: Declaration -> m ()
53− lintDeclaration d =
54− let (f, _, _, _, _) = everythingWithContextOnValues moduleNames mempty mappend def stepE stepB def def
55− in tell (f d)
56− where
57− def s _ = (s, mempty)
58−
59− stepE :: S.Set Ident -> Expr -> (S.Set Ident, MultipleErrors)
60− stepE s (Abs (Left name) _) = bind s name
61− stepE s (Let ds' _) =
62− case mapAccumL bind s (nub (mapMaybe getDeclIdent ds')) of
63− (s', es) -> (s', mconcat es)
64− stepE s _ = (s, mempty)
65−
66− stepB :: S.Set Ident -> Binder -> (S.Set Ident, MultipleErrors)
67− stepB s (VarBinder name) = bind s name
68− stepB s (NamedBinder name _) = bind s name
69− stepB s _ = (s, mempty)
70−
71− bind :: S.Set Ident -> Ident -> (S.Set Ident, MultipleErrors)
72− bind s name | name `S.member` s = (s, errorMessage (ShadowedName name))
73− | otherwise = (S.insert name s, mempty)
src/Language/PureScript/ModuleDependencies.hsdeleted−77
@@ -1,77 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.ModuleDependencies
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Provides the ability to sort modules based on module dependencies
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE FlexibleContexts #-}
16−
17−module Language.PureScript.ModuleDependencies (
18− sortModules,
19− ModuleGraph
20−) where
21−
22−import Control.Monad.Error.Class (MonadError(..))
23−
24−import Data.Graph
25−import Data.List (nub)
26−import Data.Maybe (mapMaybe)
27−
28−import Language.PureScript.AST
29−import Language.PureScript.Names
30−import Language.PureScript.Types
31−import Language.PureScript.Errors
32−
33−-- |
34−-- A list of modules with their dependencies
35−--
36−type ModuleGraph = [(ModuleName, [ModuleName])]
37−
38−-- |
39−-- Sort a collection of modules based on module dependencies.
40−--
41−-- Reports an error if the module graph contains a cycle.
42−--
43−sortModules :: (MonadError MultipleErrors m) => [Module] -> m ([Module], ModuleGraph)
44−sortModules ms = do
45− let verts = map (\m@(Module _ _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms
46− ms' <- mapM toModule $ stronglyConnComp verts
47− let moduleGraph = map (\(_, mn, deps) -> (mn, deps)) verts
48− return (ms', moduleGraph)
49−
50−-- |
51−-- Calculate a list of used modules based on explicit imports and qualified names
52−--
53−usedModules :: Declaration -> [ModuleName]
54−usedModules = let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (const []) (const []) (const []) in nub . f
55− where
56− forDecls :: Declaration -> [ModuleName]
57− forDecls (ImportDeclaration mn _ _) = [mn]
58− forDecls _ = []
59−
60− forValues :: Expr -> [ModuleName]
61− forValues (Var (Qualified (Just mn) _)) = [mn]
62− forValues (Constructor (Qualified (Just mn) _)) = [mn]
63− forValues (TypedValue _ _ ty) = forTypes ty
64− forValues _ = []
65−
66− forTypes :: Type -> [ModuleName]
67− forTypes (TypeConstructor (Qualified (Just mn) _)) = [mn]
68− forTypes (ConstrainedType cs _) = mapMaybe (\(Qualified mn _, _) -> mn) cs
69− forTypes _ = []
70−
71−-- |
72−-- Convert a strongly connected component of the module graph to a module
73−--
74−toModule :: (MonadError MultipleErrors m) => SCC Module -> m Module
75−toModule (AcyclicSCC m) = return m
76−toModule (CyclicSCC [m]) = return m
77−toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)
src/Language/PureScript/Names.hsdeleted−85
@@ -1,85 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Names
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Data types for names
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
17−
18−module Language.PureScript.Names where
19−
20−import Data.List
21−import Data.Data
22−
23−-- |
24−-- Names for value identifiers
25−--
26−data Ident
27− -- |
28− -- An alphanumeric identifier
29− --
30− = Ident String
31− -- |
32− -- A symbolic name for an infix operator
33− --
34− | Op String deriving (Eq, Ord, Data, Typeable)
35−
36−runIdent :: Ident -> String
37−runIdent (Ident i) = i
38−runIdent (Op op) = op
39−
40−instance Show Ident where
41− show (Ident s) = s
42− show (Op op) = '(':op ++ ")"
43−
44−-- |
45−-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.
46−--
47−newtype ProperName = ProperName { runProperName :: String } deriving (Eq, Ord, Data, Typeable)
48−
49−instance Show ProperName where
50− show = runProperName
51−
52−-- |
53−-- Module names
54−--
55−data ModuleName = ModuleName [ProperName] deriving (Eq, Ord, Data, Typeable)
56−
57−runModuleName :: ModuleName -> String
58−runModuleName (ModuleName pns) = intercalate "." (runProperName `map` pns)
59−
60−moduleNameFromString :: String -> ModuleName
61−moduleNameFromString = ModuleName . splitProperNames
62− where
63− splitProperNames s = case dropWhile (== '.') s of
64− "" -> []
65− s' -> ProperName w : splitProperNames s''
66− where (w, s'') = break (== '.') s'
67−
68−instance Show ModuleName where
69− show = runModuleName
70−
71−-- |
72−-- A qualified name, i.e. a name with an optional module name
73−--
74−data Qualified a = Qualified (Maybe ModuleName) a deriving (Eq, Ord, Data, Typeable, Functor)
75−
76−instance (Show a) => Show (Qualified a) where
77− show (Qualified Nothing a) = show a
78− show (Qualified (Just name) a) = show name ++ "." ++ show a
79−
80−-- |
81−-- Provide a default module name, if a name is unqualified
82−--
83−qualify :: ModuleName -> Qualified a -> (ModuleName, a)
84−qualify m (Qualified Nothing a) = (m, a)
85−qualify _ (Qualified (Just m) a) = (m, a)
src/Language/PureScript/Options.hsdeleted−92
@@ -1,92 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Options
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- The data type of compiler options
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE GADTs, DataKinds, StandaloneDeriving #-}
17−
18−module Language.PureScript.Options where
19−
20−-- |
21−-- Indicates the mode of the compiler. Lifted using DataKinds to refine the Options type.
22−--
23−data Mode = Compile | Make
24−
25−-- |
26−-- Per-mode options
27−--
28−data ModeOptions mode where
29− CompileOptions :: String -> [String] -> [String] -> ModeOptions Compile
30− MakeOptions :: ModeOptions Make
31−
32−browserNamespace :: ModeOptions Compile -> String
33−browserNamespace (CompileOptions ns _ _) = ns
34−
35−entryPointModules :: ModeOptions Compile -> [String]
36−entryPointModules (CompileOptions _ ms _) = ms
37−
38−codeGenModules :: ModeOptions Compile -> [String]
39−codeGenModules (CompileOptions _ _ ms) = ms
40−
41−deriving instance Show (ModeOptions mode)
42−
43−-- |
44−-- The data type of compiler options
45−--
46−data Options mode = Options {
47− -- |
48− -- Disable inclusion of the built in Prelude
49− --
50− optionsNoPrelude :: Bool
51− -- |
52− -- Disable tail-call elimination
53− --
54− , optionsNoTco :: Bool
55− -- |
56− -- Disable inlining of calls to return and bind for the Eff monad
57− --
58− , optionsNoMagicDo :: Bool
59− -- |
60− -- When specified, checks the type of `main` in the module, and generate a call to run main
61− -- after the module definitions.
62− --
63− , optionsMain :: Maybe String
64− -- |
65− -- Skip all optimizations
66− --
67− , optionsNoOptimizations :: Bool
68− -- |
69− -- Verbose error message
70− --
71− , optionsVerboseErrors :: Bool
72− -- |
73− -- Remove the comments from the generated js
74− , optionsNoComments :: Bool
75− -- |
76− -- Specify the namespace that PureScript modules will be exported to when running in the
77− -- browser.
78− --
79− , optionsAdditional :: ModeOptions mode
80− } deriving Show
81−
82−-- |
83−-- Default compiler options
84−--
85−defaultCompileOptions :: Options Compile
86−defaultCompileOptions = Options False False False Nothing False False False (CompileOptions "PS" [] [])
87−
88−-- |
89−-- Default make options
90−--
91−defaultMakeOptions :: Options Make
92−defaultMakeOptions = Options False False False Nothing False False False MakeOptions
src/Language/PureScript/Parser.hsdeleted−36
@@ -1,36 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- A collection of parsers for core data types:
13−--
14−-- [@Language.PureScript.Parser.Kinds@] Parser for kinds
15−--
16−-- [@Language.PureScript.Parser.Values@] Parser for values
17−--
18−-- [@Language.PureScript.Parser.Types@] Parser for types
19−--
20−-- [@Language.PureScript.Parser.Declaration@] Parsers for declarations and modules
21−--
22−-- [@Language.PureScript.Parser.State@] Parser state, including indentation
23−--
24−-- [@Language.PureScript.Parser.Common@] Common parsing utility functions
25−--
26−-----------------------------------------------------------------------------
27−
28−module Language.PureScript.Parser (module P) where
29−
30−import Language.PureScript.Parser.Common as P
31−import Language.PureScript.Parser.Types as P
32−import Language.PureScript.Parser.State as P
33−import Language.PureScript.Parser.Kinds as P
34−import Language.PureScript.Parser.Lexer as P
35−import Language.PureScript.Parser.Declarations as P
36−import Language.PureScript.Parser.JS as P
src/Language/PureScript/Parser/Common.hsdeleted−139
@@ -1,139 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser.Common
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Constants, and utility functions to be used when parsing
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE FlexibleContexts #-}
17−
18−module Language.PureScript.Parser.Common where
19−
20−import Control.Applicative
21−import Control.Monad (guard)
22−
23−import Language.PureScript.Comments
24−import Language.PureScript.Parser.Lexer
25−import Language.PureScript.Parser.State
26−import Language.PureScript.Names
27−
28−import qualified Text.Parsec as P
29−
30−featureWasRemoved :: String -> TokenParser a
31−featureWasRemoved err = do
32− pos <- P.getPosition
33− error $ "It looks like you are trying to use a feature from a previous version of the compiler:\n" ++ err ++ "\nat " ++ show pos
34−
35−properName :: TokenParser ProperName
36−properName = ProperName <$> uname
37−
38−-- |
39−-- Parse a module name
40−--
41−moduleName :: TokenParser ModuleName
42−moduleName = part []
43− where
44− part path = (do name <- ProperName <$> P.try qualifier
45− part (path `snoc` name))
46− <|> (ModuleName . snoc path . ProperName <$> mname)
47− snoc path name = path ++ [name]
48−
49−-- |
50−-- Parse a qualified name, i.e. M.name or just name
51−--
52−parseQualified :: TokenParser a -> TokenParser (Qualified a)
53−parseQualified parser = part []
54− where
55− part path = (do name <- ProperName <$> P.try qualifier
56− part (updatePath path name))
57− <|> (Qualified (qual path) <$> P.try parser)
58− updatePath path name = path ++ [name]
59− qual path = if null path then Nothing else Just $ ModuleName path
60−
61−-- |
62−-- Parse an identifier or parenthesized operator
63−--
64−parseIdent :: TokenParser Ident
65−parseIdent = (Ident <$> identifier) <|> (Op <$> parens symbol)
66−
67−-- |
68−-- Run the first parser, then match the second if possible, applying the specified function on a successful match
69−--
70−augment :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
71−augment p q f = flip (maybe id $ flip f) <$> p <*> P.optionMaybe q
72−
73−-- |
74−-- Run the first parser, then match the second zero or more times, applying the specified function for each match
75−--
76−fold :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
77−fold first more combine = do
78− a <- first
79− bs <- P.many more
80− return $ foldl combine a bs
81−
82−-- |
83−-- Build a parser from a smaller parser and a list of parsers for postfix operators
84−--
85−buildPostfixParser :: P.Stream s m t => [a -> P.ParsecT s u m a] -> P.ParsecT s u m a -> P.ParsecT s u m a
86−buildPostfixParser fs first = do
87− a <- first
88− go a
89− where
90− go a = do
91− maybeA <- P.optionMaybe $ P.choice (map ($ a) fs)
92− case maybeA of
93− Nothing -> return a
94− Just a' -> go a'
95−
96−-- |
97−-- Mark the current indentation level
98−--
99−mark :: P.Parsec s ParseState a -> P.Parsec s ParseState a
100−mark p = do
101− current <- indentationLevel <$> P.getState
102− pos <- P.sourceColumn <$> P.getPosition
103− P.modifyState $ \st -> st { indentationLevel = pos }
104− a <- p
105− P.modifyState $ \st -> st { indentationLevel = current }
106− return a
107−
108−-- |
109−-- Check that the current identation level matches a predicate
110−--
111−checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec s ParseState ()
112−checkIndentation rel = do
113− col <- P.sourceColumn <$> P.getPosition
114− current <- indentationLevel <$> P.getState
115− guard (col `rel` current)
116−
117−-- |
118−-- Check that the current indentation level is past the current mark
119−--
120−indented :: P.Parsec s ParseState ()
121−indented = checkIndentation (>) P.<?> "indentation"
122−
123−-- |
124−-- Check that the current indentation level is at the same indentation as the current mark
125−--
126−same :: P.Parsec s ParseState ()
127−same = checkIndentation (==) P.<?> "no indentation"
128−
129−-- |
130−-- Read the comments from the the next token, without consuming it
131−--
132−readComments :: P.Parsec [PositionedToken] u [Comment]
133−readComments = P.lookAhead $ ptComments <$> P.anyToken
134−
135−-- |
136−-- Run a parser
137−--
138−runTokenParser :: FilePath -> TokenParser a -> [PositionedToken] -> Either P.ParseError a
139−runTokenParser filePath p = P.runParser p (ParseState 0) filePath
src/Language/PureScript/Parser/Declarations.hsdeleted−543
@@ -1,543 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser.Declarations
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Parsers for module definitions and declarations
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# LANGUAGE TupleSections #-}
19−
20−module Language.PureScript.Parser.Declarations (
21− parseDeclaration,
22− parseModule,
23− parseModules,
24− parseModulesFromFiles,
25− parseValue,
26− parseGuard,
27− parseBinder,
28− parseBinderNoParens,
29− parseImportDeclaration',
30− parseLocalDeclaration
31−) where
32−
33−import Prelude hiding (lex)
34−
35−import Data.Maybe (fromMaybe)
36−
37−import Control.Applicative
38−import Control.Arrow ((+++))
39−import Control.Monad.Error.Class (MonadError(..))
40−
41−import Language.PureScript.AST
42−import Language.PureScript.Comments
43−import Language.PureScript.Environment
44−import Language.PureScript.Errors
45−import Language.PureScript.Kinds
46−import Language.PureScript.Names
47−import Language.PureScript.Parser.Common
48−import Language.PureScript.Parser.Kinds
49−import Language.PureScript.Parser.Lexer
50−import Language.PureScript.Parser.Types
51−
52−import qualified Language.PureScript.Parser.Common as C
53−import qualified Text.Parsec as P
54−import qualified Text.Parsec.Expr as P
55−
56−-- |
57−-- Read source position information
58−--
59−withSourceSpan :: (SourceSpan -> [Comment] -> a -> a) -> P.Parsec [PositionedToken] u a -> P.Parsec [PositionedToken] u a
60−withSourceSpan f p = do
61− start <- P.getPosition
62− comments <- C.readComments
63− x <- p
64− end <- P.getPosition
65− let sp = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)
66− return $ f sp comments x
67− where
68− toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)
69−
70−kindedIdent :: TokenParser (String, Maybe Kind)
71−kindedIdent = (, Nothing) <$> identifier
72− <|> parens ((,) <$> identifier <*> (Just <$> (indented *> doubleColon *> indented *> parseKind)))
73−
74−parseDataDeclaration :: TokenParser Declaration
75−parseDataDeclaration = do
76− dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)
77− name <- indented *> properName
78− tyArgs <- many (indented *> kindedIdent)
79− ctors <- P.option [] $ do
80− indented *> equals
81− P.sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe
82− return $ DataDeclaration dtype name tyArgs ctors
83−
84−parseTypeDeclaration :: TokenParser Declaration
85−parseTypeDeclaration =
86− TypeDeclaration <$> P.try (parseIdent <* indented <* doubleColon)
87− <*> parsePolyType
88−
89−parseTypeSynonymDeclaration :: TokenParser Declaration
90−parseTypeSynonymDeclaration =
91− TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName)
92− <*> many (indented *> kindedIdent)
93− <*> (indented *> equals *> noWildcards parsePolyType)
94−
95−parseValueDeclaration :: TokenParser Declaration
96−parseValueDeclaration = do
97− name <- parseIdent
98− binders <- P.many parseBinderNoParens
99− value <- Left <$> (C.indented *>
100− P.many1 ((,) <$> parseGuard
101− <*> (indented *> equals *> parseValueWithWhereClause)
102− ))
103− <|> Right <$> (indented *> equals *> parseValueWithWhereClause)
104− return $ ValueDeclaration name Public binders value
105− where
106− parseValueWithWhereClause :: TokenParser Expr
107− parseValueWithWhereClause = do
108− value <- parseValue
109− whereClause <- P.optionMaybe $ do
110− C.indented
111− reserved "where"
112− C.indented
113− C.mark $ P.many1 (C.same *> parseLocalDeclaration)
114− return $ maybe value (`Let` value) whereClause
115−
116−parseExternDeclaration :: TokenParser Declaration
117−parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "import" *> indented *>
118− (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
119− <*> (indented *> doubleColon *> parseKind)
120− <|> (do reserved "instance"
121− name <- parseIdent <* indented <* doubleColon
122− deps <- P.option [] $ do
123− deps' <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
124− indented
125− rfatArrow
126− return deps'
127− className <- indented *> parseQualified properName
128− tys <- P.many (indented *> noWildcards parseTypeAtom)
129− return $ ExternInstanceDeclaration name deps className tys)
130− <|> (do ident <- parseIdent
131− -- TODO: add a wiki page link with migration info
132− -- TODO: remove this deprecation warning in 0.8
133− _ <- P.optional $ stringLiteral *> featureWasRemoved "Inline foreign string literals are no longer supported."
134− ty <- indented *> doubleColon *> noWildcards parsePolyType
135− return $ ExternDeclaration ident ty))
136−
137−parseAssociativity :: TokenParser Associativity
138−parseAssociativity =
139− (P.try (reserved "infixl") >> return Infixl) <|>
140− (P.try (reserved "infixr") >> return Infixr) <|>
141− (P.try (reserved "infix") >> return Infix)
142−
143−parseFixity :: TokenParser Fixity
144−parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)
145−
146−parseFixityDeclaration :: TokenParser Declaration
147−parseFixityDeclaration = do
148− fixity <- parseFixity
149− indented
150− name <- symbol
151− return $ FixityDeclaration fixity name
152−
153−parseImportDeclaration :: TokenParser Declaration
154−parseImportDeclaration = do
155− (mn, declType, asQ) <- parseImportDeclaration'
156− return $ ImportDeclaration mn declType asQ
157−
158−parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName)
159−parseImportDeclaration' = do
160− reserved "import"
161− indented
162− qualImport <|> stdImport
163− where
164− stdImport = do
165− moduleName' <- moduleName
166− stdImportHiding moduleName' <|> stdImportQualifying moduleName'
167− where
168− stdImportHiding mn = do
169− reserved "hiding"
170− declType <- importDeclarationType Hiding
171− return (mn, declType, Nothing)
172− stdImportQualifying mn = do
173− declType <- importDeclarationType Explicit
174− return (mn, declType, Nothing)
175− qualImport = do
176− reserved "qualified"
177− indented
178− moduleName' <- moduleName
179− declType <- importDeclarationType Explicit
180− reserved "as"
181− asQ <- moduleName
182− return (moduleName', declType, Just asQ)
183− importDeclarationType expectedType = do
184− idents <- P.optionMaybe $ indented *> parens (commaSep parseDeclarationRef)
185− return $ fromMaybe Implicit (expectedType <$> idents)
186−
187−
188−parseDeclarationRef :: TokenParser DeclarationRef
189−parseDeclarationRef = withSourceSpan PositionedDeclarationRef $
190− ValueRef <$> parseIdent
191− <|> do name <- properName
192− dctors <- P.optionMaybe $ parens (symbol' ".." *> pure Nothing <|> Just <$> commaSep properName)
193− return $ maybe (TypeClassRef name) (TypeRef name) dctors
194−
195−parseTypeClassDeclaration :: TokenParser Declaration
196−parseTypeClassDeclaration = do
197− reserved "class"
198− implies <- P.option [] $ do
199− indented
200− implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
201− lfatArrow
202− return implies
203− className <- indented *> properName
204− idents <- P.many (indented *> kindedIdent)
205− members <- P.option [] . P.try $ do
206− indented *> reserved "where"
207− mark (P.many (same *> positioned parseTypeDeclaration))
208− return $ TypeClassDeclaration className idents implies members
209−
210−parseTypeInstanceDeclaration :: TokenParser Declaration
211−parseTypeInstanceDeclaration = do
212− reserved "instance"
213− name <- parseIdent <* indented <* doubleColon
214− deps <- P.optionMaybe $ do
215− deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
216− indented
217− rfatArrow
218− return deps
219− className <- indented *> parseQualified properName
220− ty <- P.many (indented *> noWildcards parseTypeAtom)
221− members <- P.option [] . P.try $ do
222− indented *> reserved "where"
223− mark (P.many (same *> positioned parseValueDeclaration))
224− return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members
225−
226−positioned :: TokenParser Declaration -> TokenParser Declaration
227−positioned = withSourceSpan PositionedDeclaration
228−
229−-- |
230−-- Parse a single declaration
231−--
232−parseDeclaration :: TokenParser Declaration
233−parseDeclaration = positioned (P.choice
234− [ parseDataDeclaration
235− , parseTypeDeclaration
236− , parseTypeSynonymDeclaration
237− , parseValueDeclaration
238− , parseExternDeclaration
239− , parseFixityDeclaration
240− , parseImportDeclaration
241− , parseTypeClassDeclaration
242− , parseTypeInstanceDeclaration
243− ]) P.<?> "declaration"
244−
245−parseLocalDeclaration :: TokenParser Declaration
246−parseLocalDeclaration = positioned (P.choice
247− [ parseTypeDeclaration
248− , parseValueDeclaration
249− ] P.<?> "local declaration")
250−
251−-- |
252−-- Parse a module header and a collection of declarations
253−--
254−parseModule :: TokenParser Module
255−parseModule = do
256− comments <- C.readComments
257− reserved "module"
258− indented
259− name <- moduleName
260− exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef
261− reserved "where"
262− decls <- mark (P.many (same *> parseDeclaration))
263− return $ Module comments name decls exports
264−
265−-- |
266−-- Parse a collection of modules
267−--
268−parseModulesFromFiles :: forall m k. (MonadError MultipleErrors m, Functor m) =>
269− (k -> String) -> [(k, String)] -> m [(k, Module)]
270−parseModulesFromFiles toFilePath input = do
271− modules <- parU input $ \(k, content) -> do
272− let filename = toFilePath k
273− ts <- wrapError $ lex filename content
274− ms <- wrapError $ runTokenParser filename parseModules ts
275− return (k, ms)
276− return $ collect modules
277− where
278− wrapError :: Either P.ParseError a -> m a
279− wrapError = either (throwError . errorMessage . ErrorParsingModule) return
280− collect :: [(k, [v])] -> [(k, v)]
281− collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
282−
283−-- |
284−-- Parse a collection of modules
285−--
286−parseModules :: TokenParser [Module]
287−parseModules = mark (P.many (same *> parseModule)) <* P.eof
288−
289−booleanLiteral :: TokenParser Bool
290−booleanLiteral = (reserved "true" >> return True) P.<|> (reserved "false" >> return False)
291−
292−parseNumericLiteral :: TokenParser Expr
293−parseNumericLiteral = NumericLiteral <$> number
294−
295−parseCharLiteral :: TokenParser Expr
296−parseCharLiteral = CharLiteral <$> charLiteral
297−
298−parseStringLiteral :: TokenParser Expr
299−parseStringLiteral = StringLiteral <$> stringLiteral
300−
301−parseBooleanLiteral :: TokenParser Expr
302−parseBooleanLiteral = BooleanLiteral <$> booleanLiteral
303−
304−parseArrayLiteral :: TokenParser Expr
305−parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)
306−
307−parseObjectLiteral :: TokenParser Expr
308−parseObjectLiteral = ObjectConstructor <$> braces (commaSep parseIdentifierAndValue)
309−
310−parseIdentifierAndValue :: TokenParser (String, Maybe Expr)
311−parseIdentifierAndValue = (,) <$> (C.indented *> (lname <|> stringLiteral) <* C.indented <* colon)
312− <*> (C.indented *> val)
313− where
314− val = (Just <$> parseValue) <|> (underscore *> pure Nothing)
315−
316−parseAbs :: TokenParser Expr
317−parseAbs = do
318− symbol' "\\"
319− args <- P.many1 (C.indented *> (Abs <$> (Left <$> P.try C.parseIdent <|> Right <$> parseBinderNoParens)))
320− C.indented *> rarrow
321− value <- parseValue
322− return $ toFunction args value
323− where
324− toFunction :: [Expr -> Expr] -> Expr -> Expr
325− toFunction args value = foldr ($) value args
326−
327−parseVar :: TokenParser Expr
328−parseVar = Var <$> C.parseQualified C.parseIdent
329−
330−parseConstructor :: TokenParser Expr
331−parseConstructor = Constructor <$> C.parseQualified C.properName
332−
333−parseCase :: TokenParser Expr
334−parseCase = Case <$> P.between (P.try (reserved "case")) (C.indented *> reserved "of") (return <$> parseValue)
335− <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))
336−
337−parseCaseAlternative :: TokenParser CaseAlternative
338−parseCaseAlternative = CaseAlternative <$> (return <$> parseBinder)
339− <*> (Left <$> (C.indented *>
340− P.many1 ((,) <$> parseGuard
341− <*> (indented *> rarrow *> parseValue)
342− ))
343− <|> Right <$> (indented *> rarrow *> parseValue))
344− P.<?> "case alternative"
345−
346−parseIfThenElse :: TokenParser Expr
347−parseIfThenElse = IfThenElse <$> (P.try (reserved "if") *> C.indented *> parseValue)
348− <*> (C.indented *> reserved "then" *> C.indented *> parseValue)
349− <*> (C.indented *> reserved "else" *> C.indented *> parseValue)
350−
351−parseLet :: TokenParser Expr
352−parseLet = do
353− reserved "let"
354− C.indented
355− ds <- C.mark $ P.many1 (C.same *> parseLocalDeclaration)
356− C.indented
357− reserved "in"
358− result <- parseValue
359− return $ Let ds result
360−
361−parseValueAtom :: TokenParser Expr
362−parseValueAtom = P.choice
363− [ P.try parseNumericLiteral
364− , P.try parseCharLiteral
365− , P.try parseStringLiteral
366− , P.try parseBooleanLiteral
367− , parseArrayLiteral
368− , P.try parseObjectLiteral
369− , P.try parseObjectGetter
370− , parseAbs
371− , P.try parseConstructor
372− , P.try parseVar
373− , parseCase
374− , parseIfThenElse
375− , parseDo
376− , parseLet
377− , P.try $ Parens <$> parens parseValue
378− , parseOperatorSection
379− , P.try parseObjectUpdaterWildcard ]
380−
381−-- |
382−-- Parse an expression in backticks or an operator
383−--
384−parseInfixExpr :: TokenParser Expr
385−parseInfixExpr = P.between tick tick parseValue
386− <|> Var <$> parseQualified (Op <$> symbol)
387−
388−parseOperatorSection :: TokenParser Expr
389−parseOperatorSection = parens $ left <|> right
390− where
391− right = OperatorSection <$> parseInfixExpr <* indented <*> (Right <$> parseValueAtom)
392− left = flip OperatorSection <$> (Left <$> parseValueAtom) <* indented <*> parseInfixExpr
393−
394−parsePropertyUpdate :: TokenParser (String, Maybe Expr)
395−parsePropertyUpdate = do
396− name <- lname <|> stringLiteral
397− _ <- C.indented *> equals
398− value <- C.indented *> (underscore *> pure Nothing) <|> (Just <$> parseValue)
399− return (name, value)
400−
401−parseAccessor :: Expr -> TokenParser Expr
402−parseAccessor (Constructor _) = P.unexpected "constructor"
403−parseAccessor obj = P.try $ Accessor <$> (C.indented *> dot *> C.indented *> (lname <|> stringLiteral)) <*> pure obj
404−
405−parseDo :: TokenParser Expr
406−parseDo = do
407− reserved "do"
408− C.indented
409− Do <$> C.mark (P.many (C.same *> C.mark parseDoNotationElement))
410−
411−parseDoNotationLet :: TokenParser DoNotationElement
412−parseDoNotationLet = DoNotationLet <$> (reserved "let" *> C.indented *> C.mark (P.many1 (C.same *> parseLocalDeclaration)))
413−
414−parseDoNotationBind :: TokenParser DoNotationElement
415−parseDoNotationBind = DoNotationBind <$> parseBinder <*> (C.indented *> larrow *> parseValue)
416−
417−parseDoNotationElement :: TokenParser DoNotationElement
418−parseDoNotationElement = P.choice
419− [ P.try parseDoNotationBind
420− , parseDoNotationLet
421− , P.try (DoNotationValue <$> parseValue) ]
422−
423−parseObjectGetter :: TokenParser Expr
424−parseObjectGetter = ObjectGetter <$> (underscore *> C.indented *> dot *> C.indented *> (lname <|> stringLiteral))
425−
426−-- |
427−-- Parse a value
428−--
429−parseValue :: TokenParser Expr
430−parseValue = withSourceSpan PositionedValue
431− (P.buildExpressionParser operators
432− . C.buildPostfixParser postfixTable2
433− $ indexersAndAccessors) P.<?> "expression"
434− where
435− indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom
436− postfixTable1 = [ parseAccessor
437− , P.try . parseUpdaterBody . Just ]
438− postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v
439− , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v
440− ]
441− operators = [ [ P.Prefix (P.try (C.indented *> symbol' "-") >> return UnaryMinus)
442− ]
443− , [ P.Infix (P.try (C.indented *> parseInfixExpr P.<?> "infix expression") >>= \ident ->
444− return (BinaryNoParens ident)) P.AssocRight
445− ]
446− ]
447−
448−parseUpdaterBody :: Maybe Expr -> TokenParser Expr
449−parseUpdaterBody v = ObjectUpdater v <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate)))
450−
451−parseObjectUpdaterWildcard :: TokenParser Expr
452−parseObjectUpdaterWildcard = underscore *> C.indented *> parseUpdaterBody Nothing
453−
454−parseStringBinder :: TokenParser Binder
455−parseStringBinder = StringBinder <$> stringLiteral
456−
457−parseCharBinder :: TokenParser Binder
458−parseCharBinder = CharBinder <$> charLiteral
459−
460−parseBooleanBinder :: TokenParser Binder
461−parseBooleanBinder = BooleanBinder <$> booleanLiteral
462−
463−parseNumberBinder :: TokenParser Binder
464−parseNumberBinder = NumberBinder <$> (sign <*> number)
465− where
466− sign :: TokenParser (Either Integer Double -> Either Integer Double)
467− sign = (symbol' "-" >> return (negate +++ negate))
468− <|> (symbol' "+" >> return id)
469− <|> return id
470−
471−parseVarBinder :: TokenParser Binder
472−parseVarBinder = VarBinder <$> C.parseIdent
473−
474−parseNullaryConstructorBinder :: TokenParser Binder
475−parseNullaryConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> pure []
476−
477−parseConstructorBinder :: TokenParser Binder
478−parseConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> many (C.indented *> parseBinderNoParens)
479−
480−parseObjectBinder :: TokenParser Binder
481−parseObjectBinder = ObjectBinder <$> braces (commaSep (C.indented *> parseIdentifierAndBinder))
482−
483−parseArrayBinder :: TokenParser Binder
484−parseArrayBinder = squares $ ArrayBinder <$> commaSep (C.indented *> parseBinder)
485−
486−parseNamedBinder :: TokenParser Binder
487−parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* at)
488− <*> (C.indented *> parseBinder)
489−
490−parseNullBinder :: TokenParser Binder
491−parseNullBinder = underscore *> return NullBinder
492−
493−parseIdentifierAndBinder :: TokenParser (String, Binder)
494−parseIdentifierAndBinder = do
495− name <- lname <|> stringLiteral
496− C.indented *> (equals <|> colon)
497− binder <- C.indented *> parseBinder
498− return (name, binder)
499−
500−-- |
501−-- Parse a binder
502−--
503−parseBinder :: TokenParser Binder
504−parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom)
505− where
506− -- TODO: remove this deprecation warning in 0.8
507− operators = [ [ P.Infix (P.try $ C.indented *> colon *> featureWasRemoved "Cons binders are no longer supported. Consider using purescript-lists or purescript-sequences instead.") P.AssocRight ] ]
508− parseBinderAtom :: TokenParser Binder
509− parseBinderAtom = P.choice (map P.try
510− [ parseNullBinder
511− , parseCharBinder
512− , parseStringBinder
513− , parseBooleanBinder
514− , parseNumberBinder
515− , parseNamedBinder
516− , parseVarBinder
517− , parseConstructorBinder
518− , parseObjectBinder
519− , parseArrayBinder
520− , parens parseBinder ]) P.<?> "binder"
521−
522−-- |
523−-- Parse a binder as it would appear in a top level declaration
524−--
525−parseBinderNoParens :: TokenParser Binder
526−parseBinderNoParens = P.choice (map P.try
527− [ parseNullBinder
528− , parseCharBinder
529− , parseStringBinder
530− , parseBooleanBinder
531− , parseNumberBinder
532− , parseNamedBinder
533− , parseVarBinder
534− , parseNullaryConstructorBinder
535− , parseObjectBinder
536− , parseArrayBinder
537− , parens parseBinder ]) P.<?> "binder"
538−
539−-- |
540−-- Parse a guard
541−--
542−parseGuard :: TokenParser Guard
543−parseGuard = pipe *> C.indented *> parseValue
src/Language/PureScript/Parser/JS.hsdeleted−59
@@ -1,59 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Foreign
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE FlexibleContexts #-}
16−
17−module Language.PureScript.Parser.JS
18− ( ForeignJS()
19− , parseForeignModulesFromFiles
20− ) where
21−
22−import Control.Applicative ((*>), (<*))
23−import Control.Monad (forM_, when, msum)
24−import Control.Monad.Error.Class (MonadError(..))
25−import Control.Monad.Writer.Class (MonadWriter(..))
26−import Data.Function (on)
27−import Data.List (sortBy, groupBy)
28−import Language.PureScript.Errors
29−import Language.PureScript.Names
30−import Language.PureScript.Parser.Common
31−import Language.PureScript.Parser.Lexer
32−import Prelude hiding (lex)
33−import qualified Data.Map as M
34−import qualified Text.Parsec as PS
35−
36−type ForeignJS = String
37−
38−parseForeignModulesFromFiles :: (Functor m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
39− => [(FilePath, ForeignJS)]
40− -> m (M.Map ModuleName (FilePath, ForeignJS))
41−parseForeignModulesFromFiles files = do
42− foreigns <- parU files $ \(path, file) ->
43− case findModuleName (lines file) of
44− Just name -> return (name, (path, file))
45− Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)
46− let grouped = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) foreigns
47− forM_ grouped $ \grp ->
48− when (length grp > 1) $ do
49− let mn = fst (head grp)
50− paths = map (fst . snd) grp
51− tell $ errorMessage $ MultipleFFIModules mn paths
52− return $ M.fromList foreigns
53−
54−findModuleName :: [String] -> Maybe ModuleName
55−findModuleName = msum . map parseComment
56− where
57− parseComment :: String -> Maybe ModuleName
58− parseComment s = either (const Nothing) Just $
59− lex "" s >>= runTokenParser "" (symbol' "//" *> reserved "module" *> moduleName <* PS.eof)
src/Language/PureScript/Parser/Kinds.hsdeleted−45
@@ -1,45 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser.Kinds
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- A parser for kinds
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.Parser.Kinds (
17− parseKind
18−) where
19−
20−import Language.PureScript.Kinds
21−import Language.PureScript.Parser.Common
22−import Language.PureScript.Parser.Lexer
23−import Control.Applicative
24−import qualified Text.Parsec as P
25−import qualified Text.Parsec.Expr as P
26−
27−parseStar :: TokenParser Kind
28−parseStar = const Star <$> symbol' "*"
29−
30−parseBang :: TokenParser Kind
31−parseBang = const Bang <$> symbol' "!"
32−
33−parseTypeAtom :: TokenParser Kind
34−parseTypeAtom = indented *> P.choice (map P.try
35− [ parseStar
36− , parseBang
37− , parens parseKind ])
38−-- |
39−-- Parse a kind
40−--
41−parseKind :: TokenParser Kind
42−parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"
43− where
44− operators = [ [ P.Prefix (symbol' "#" >> return Row) ]
45− , [ P.Infix ((P.try rarrow) >> return FunKind) P.AssocRight ] ]
src/Language/PureScript/Parser/Lexer.hsdeleted−512
@@ -1,512 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser.Lexer
4−-- Copyright : (c) Phil Freeman 2014
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- The first step in the parsing process - turns source code into a list of lexemes
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE TupleSections #-}
17−
18−module Language.PureScript.Parser.Lexer
19− ( PositionedToken(..)
20− , Token()
21− , TokenParser()
22− , lex
23− , anyToken
24− , token
25− , match
26− , lparen
27− , rparen
28− , parens
29− , lbrace
30− , rbrace
31− , braces
32− , lsquare
33− , rsquare
34− , squares
35− , indent
36− , indentAt
37− , larrow
38− , rarrow
39− , lfatArrow
40− , rfatArrow
41− , colon
42− , doubleColon
43− , equals
44− , pipe
45− , tick
46− , dot
47− , comma
48− , semi
49− , at
50− , underscore
51− , semiSep
52− , semiSep1
53− , commaSep
54− , commaSep1
55− , lname
56− , qualifier
57− , uname
58− , uname'
59− , mname
60− , reserved
61− , symbol
62− , symbol'
63− , identifier
64− , charLiteral
65− , stringLiteral
66− , number
67− , natural
68− , reservedPsNames
69− , reservedTypeNames
70− , opChars
71− )
72− where
73−
74−import Prelude hiding (lex)
75−
76−import Data.Char (isSpace)
77−
78−import Control.Monad (void, guard)
79−import Data.Functor.Identity
80−
81−import Control.Applicative
82−
83−import Language.PureScript.Parser.State
84−import Language.PureScript.Comments
85−
86−import qualified Text.Parsec as P
87−import qualified Text.Parsec.Token as PT
88−
89−data Token
90− = LParen
91− | RParen
92− | LBrace
93− | RBrace
94− | LSquare
95− | RSquare
96− | Indent Int
97− | LArrow
98− | RArrow
99− | LFatArrow
100− | RFatArrow
101− | Colon
102− | DoubleColon
103− | Equals
104− | Pipe
105− | Tick
106− | Dot
107− | Comma
108− | Semi
109− | At
110− | Underscore
111− | LName String
112− | UName String
113− | Qualifier String
114− | Symbol String
115− | CharLiteral Char
116− | StringLiteral String
117− | Number (Either Integer Double)
118− deriving (Show, Eq, Ord)
119−
120−prettyPrintToken :: Token -> String
121−prettyPrintToken LParen = "("
122−prettyPrintToken RParen = ")"
123−prettyPrintToken LBrace = "{"
124−prettyPrintToken RBrace = "}"
125−prettyPrintToken LSquare = "["
126−prettyPrintToken RSquare = "]"
127−prettyPrintToken LArrow = "<-"
128−prettyPrintToken RArrow = "->"
129−prettyPrintToken LFatArrow = "<="
130−prettyPrintToken RFatArrow = "=>"
131−prettyPrintToken Colon = ":"
132−prettyPrintToken DoubleColon = "::"
133−prettyPrintToken Equals = "="
134−prettyPrintToken Pipe = "|"
135−prettyPrintToken Tick = "`"
136−prettyPrintToken Dot = "."
137−prettyPrintToken Comma = ","
138−prettyPrintToken Semi = ";"
139−prettyPrintToken At = "@"
140−prettyPrintToken Underscore = "_"
141−prettyPrintToken (Indent n) = "indentation at level " ++ show n
142−prettyPrintToken (LName s) = show s
143−prettyPrintToken (UName s) = show s
144−prettyPrintToken (Qualifier _) = "qualifier"
145−prettyPrintToken (Symbol s) = s
146−prettyPrintToken (CharLiteral c) = show c
147−prettyPrintToken (StringLiteral s) = show s
148−prettyPrintToken (Number n) = either show show n
149−
150−data PositionedToken = PositionedToken
151− { ptSourcePos :: P.SourcePos
152− , ptToken :: Token
153− , ptComments :: [Comment]
154− } deriving (Eq)
155−
156−instance Show PositionedToken where
157− show = show . ptToken
158−
159−lex :: FilePath -> String -> Either P.ParseError [PositionedToken]
160−lex filePath input = P.parse parseTokens filePath input
161−
162−parseTokens :: P.Parsec String u [PositionedToken]
163−parseTokens = whitespace *> P.many parsePositionedToken <* P.skipMany parseComment <* P.eof
164−
165−whitespace :: P.Parsec String u ()
166−whitespace = P.skipMany (P.satisfy isSpace)
167−
168−parseComment :: P.Parsec String u Comment
169−parseComment = (BlockComment <$> blockComment <|> LineComment <$> lineComment) <* whitespace
170− where
171− blockComment :: P.Parsec String u String
172− blockComment = P.try $ P.string "{-" *> P.manyTill P.anyChar (P.try (P.string "-}"))
173−
174− lineComment :: P.Parsec String u String
175− lineComment = P.try $ P.string "--" *> P.manyTill P.anyChar (P.try (void (P.char '\n') <|> P.eof))
176−
177−parsePositionedToken :: P.Parsec String u PositionedToken
178−parsePositionedToken = P.try $ do
179− comments <- P.many parseComment
180− pos <- P.getPosition
181− tok <- parseToken
182− return $ PositionedToken pos tok comments
183−
184−parseToken :: P.Parsec String u Token
185−parseToken = P.choice
186− [ P.try $ P.string "<-" *> P.notFollowedBy symbolChar *> pure LArrow
187− , P.try $ P.string "<=" *> P.notFollowedBy symbolChar *> pure LFatArrow
188− , P.try $ P.string "->" *> P.notFollowedBy symbolChar *> pure RArrow
189− , P.try $ P.string "=>" *> P.notFollowedBy symbolChar *> pure RFatArrow
190− , P.try $ P.string "::" *> P.notFollowedBy symbolChar *> pure DoubleColon
191− , P.try $ P.char '(' *> pure LParen
192− , P.try $ P.char ')' *> pure RParen
193− , P.try $ P.char '{' *> pure LBrace
194− , P.try $ P.char '}' *> pure RBrace
195− , P.try $ P.char '[' *> pure LSquare
196− , P.try $ P.char ']' *> pure RSquare
197− , P.try $ P.char '`' *> pure Tick
198− , P.try $ P.char ',' *> pure Comma
199− , P.try $ P.char '=' *> P.notFollowedBy symbolChar *> pure Equals
200− , P.try $ P.char ':' *> P.notFollowedBy symbolChar *> pure Colon
201− , P.try $ P.char '|' *> P.notFollowedBy symbolChar *> pure Pipe
202− , P.try $ P.char '.' *> P.notFollowedBy symbolChar *> pure Dot
203− , P.try $ P.char ';' *> P.notFollowedBy symbolChar *> pure Semi
204− , P.try $ P.char '@' *> P.notFollowedBy symbolChar *> pure At
205− , P.try $ P.char '_' *> P.notFollowedBy identLetter *> pure Underscore
206− , LName <$> parseLName
207− , do uName <- parseUName
208− (guard (validModuleName uName) >> Qualifier uName <$ P.char '.') <|> pure (UName uName)
209− , Symbol <$> parseSymbol
210− , CharLiteral <$> parseCharLiteral
211− , StringLiteral <$> parseStringLiteral
212− , Number <$> parseNumber
213− ] <* whitespace
214−
215− where
216− parseLName :: P.Parsec String u String
217− parseLName = (:) <$> identStart <*> P.many identLetter
218−
219− parseUName :: P.Parsec String u String
220− parseUName = (:) <$> P.upper <*> P.many uidentLetter
221−
222− parseSymbol :: P.Parsec String u String
223− parseSymbol = P.many1 symbolChar
224−
225− identStart :: P.Parsec String u Char
226− identStart = P.lower <|> P.oneOf "_"
227−
228− identLetter :: P.Parsec String u Char
229− identLetter = P.alphaNum <|> P.oneOf "_'"
230−
231− uidentLetter :: P.Parsec String u Char
232− uidentLetter = P.alphaNum <|> P.char '_'
233−
234− symbolChar :: P.Parsec String u Char
235− symbolChar = P.oneOf opChars
236−
237− parseCharLiteral :: P.Parsec String u Char
238− parseCharLiteral = PT.charLiteral tokenParser
239−
240− parseStringLiteral :: P.Parsec String u String
241− parseStringLiteral = blockString <|> PT.stringLiteral tokenParser
242− where
243− delimeter = P.try (P.string "\"\"\"")
244− blockString = delimeter >> P.manyTill P.anyChar delimeter
245−
246− parseNumber :: P.Parsec String u (Either Integer Double)
247− parseNumber = (Right <$> P.try (PT.float tokenParser) <|>
248− Left <$> P.try (PT.natural tokenParser)) P.<?> "number"
249−
250−-- |
251−-- We use Text.Parsec.Token to implement the string and number lexemes
252−--
253−langDef :: PT.GenLanguageDef String u Identity
254−langDef = PT.LanguageDef
255− { PT.reservedNames = []
256− , PT.reservedOpNames = []
257− , PT.commentStart = ""
258− , PT.commentEnd = ""
259− , PT.commentLine = ""
260− , PT.nestedComments = True
261− , PT.identStart = fail "Identifiers not supported"
262− , PT.identLetter = fail "Identifiers not supported"
263− , PT.opStart = fail "Operators not supported"
264− , PT.opLetter = fail "Operators not supported"
265− , PT.caseSensitive = True
266− }
267−
268−-- |
269−-- A token parser based on the language definition
270−--
271−tokenParser :: PT.GenTokenParser String u Identity
272−tokenParser = PT.makeTokenParser langDef
273−
274−type TokenParser a = P.Parsec [PositionedToken] ParseState a
275−
276−anyToken :: TokenParser PositionedToken
277−anyToken = P.token (prettyPrintToken . ptToken) ptSourcePos Just
278−
279−token :: (Token -> Maybe a) -> TokenParser a
280−token f = P.token (prettyPrintToken . ptToken) ptSourcePos (f . ptToken)
281−
282−match :: Token -> TokenParser ()
283−match tok = token (\tok' -> if tok == tok' then Just () else Nothing) P.<?> prettyPrintToken tok
284−
285−lparen :: TokenParser ()
286−lparen = match LParen
287−
288−rparen :: TokenParser ()
289−rparen = match RParen
290−
291−parens :: TokenParser a -> TokenParser a
292−parens = P.between lparen rparen
293−
294−lbrace :: TokenParser ()
295−lbrace = match LBrace
296−
297−rbrace :: TokenParser ()
298−rbrace = match RBrace
299−
300−braces :: TokenParser a -> TokenParser a
301−braces = P.between lbrace rbrace
302−
303−lsquare :: TokenParser ()
304−lsquare = match LSquare
305−
306−rsquare :: TokenParser ()
307−rsquare = match RSquare
308−
309−squares :: TokenParser a -> TokenParser a
310−squares = P.between lsquare rsquare
311−
312−indent :: TokenParser Int
313−indent = token go P.<?> "indentation"
314− where
315− go (Indent n) = Just n
316− go _ = Nothing
317−
318−indentAt :: P.Column -> TokenParser ()
319−indentAt n = token go P.<?> "indentation at level " ++ show n
320− where
321− go (Indent n') | n == n' = Just ()
322− go _ = Nothing
323−
324−larrow :: TokenParser ()
325−larrow = match LArrow
326−
327−rarrow :: TokenParser ()
328−rarrow = match RArrow
329−
330−lfatArrow :: TokenParser ()
331−lfatArrow = match LFatArrow
332−
333−rfatArrow :: TokenParser ()
334−rfatArrow = match RFatArrow
335−
336−colon :: TokenParser ()
337−colon = match Colon
338−
339−doubleColon :: TokenParser ()
340−doubleColon = match DoubleColon
341−
342−equals :: TokenParser ()
343−equals = match Equals
344−
345−pipe :: TokenParser ()
346−pipe = match Pipe
347−
348−tick :: TokenParser ()
349−tick = match Tick
350−
351−dot :: TokenParser ()
352−dot = match Dot
353−
354−comma :: TokenParser ()
355−comma = match Comma
356−
357−semi :: TokenParser ()
358−semi = match Semi
359−
360−at :: TokenParser ()
361−at = match At
362−
363−underscore :: TokenParser ()
364−underscore = match Underscore
365−
366−-- |
367−-- Parse zero or more values separated by semicolons
368−--
369−semiSep :: TokenParser a -> TokenParser [a]
370−semiSep = flip P.sepBy semi
371−
372−-- |
373−-- Parse one or more values separated by semicolons
374−--
375−semiSep1 :: TokenParser a -> TokenParser [a]
376−semiSep1 = flip P.sepBy1 semi
377−
378−-- |
379−-- Parse zero or more values separated by commas
380−--
381−commaSep :: TokenParser a -> TokenParser [a]
382−commaSep = flip P.sepBy comma
383−
384−-- |
385−-- Parse one or more values separated by commas
386−--
387−commaSep1 :: TokenParser a -> TokenParser [a]
388−commaSep1 = flip P.sepBy1 comma
389−
390−lname :: TokenParser String
391−lname = token go P.<?> "identifier"
392− where
393− go (LName s) = Just s
394− go _ = Nothing
395−
396−qualifier :: TokenParser String
397−qualifier = token go P.<?> "qualifier"
398− where
399− go (Qualifier s) = Just s
400− go _ = Nothing
401−
402−reserved :: String -> TokenParser ()
403−reserved s = token go P.<?> show s
404− where
405− go (LName s') | s == s' = Just ()
406− go _ = Nothing
407−
408−uname :: TokenParser String
409−uname = token go P.<?> "proper name"
410− where
411− go (UName s) = Just s
412− go _ = Nothing
413−
414−mname :: TokenParser String
415−mname = token go P.<?> "module name"
416− where
417− go (UName s) | validModuleName s = Just s
418− go _ = Nothing
419−
420−uname' :: String -> TokenParser ()
421−uname' s = token go P.<?> show s
422− where
423− go (UName s') | s == s' = Just ()
424− go _ = Nothing
425−
426−symbol :: TokenParser String
427−symbol = token go P.<?> "symbol"
428− where
429− go (Symbol s) = Just s
430− go Colon = Just ":"
431− go LFatArrow = Just "<="
432− go At = Just "@"
433− go _ = Nothing
434−
435−symbol' :: String -> TokenParser ()
436−symbol' s = token go P.<?> show s
437− where
438− go (Symbol s') | s == s' = Just ()
439− go Colon | s == ":" = Just ()
440− go LFatArrow | s == "<=" = Just ()
441− go _ = Nothing
442−
443−charLiteral :: TokenParser Char
444−charLiteral = token go P.<?> "char literal"
445− where
446− go (CharLiteral c) = Just c
447− go _ = Nothing
448−
449−stringLiteral :: TokenParser String
450−stringLiteral = token go P.<?> "string literal"
451− where
452− go (StringLiteral s) = Just s
453− go _ = Nothing
454−
455−number :: TokenParser (Either Integer Double)
456−number = token go P.<?> "number"
457− where
458− go (Number n) = Just n
459− go _ = Nothing
460−
461−natural :: TokenParser Integer
462−natural = token go P.<?> "natural"
463− where
464− go (Number (Left n)) = Just n
465− go _ = Nothing
466−
467−identifier :: TokenParser String
468−identifier = token go P.<?> "identifier"
469− where
470− go (LName s) | s `notElem` reservedPsNames = Just s
471− go _ = Nothing
472−
473−validModuleName :: String -> Bool
474−validModuleName s = not ('_' `elem` s)
475−
476−-- |
477−-- A list of purescript reserved identifiers
478−--
479−reservedPsNames :: [String]
480−reservedPsNames = [ "data"
481− , "newtype"
482− , "type"
483− , "foreign"
484− , "import"
485− , "infixl"
486− , "infixr"
487− , "infix"
488− , "class"
489− , "instance"
490− , "module"
491− , "case"
492− , "of"
493− , "if"
494− , "then"
495− , "else"
496− , "do"
497− , "let"
498− , "true"
499− , "false"
500− , "in"
501− , "where"
502− ]
503−
504−reservedTypeNames :: [String]
505−reservedTypeNames = [ "forall", "where" ]
506−
507−-- |
508−-- The characters allowed for use in operators
509−--
510−opChars :: [Char]
511−opChars = ":!#$%&*+./<=>?@\\^|-~"
512−
src/Language/PureScript/Parser/State.hsdeleted−30
@@ -1,30 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Parser.State
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- State for the parser monad
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.Parser.State where
17−
18−import qualified Text.Parsec as P
19−
20−-- |
21−-- State for the parser monad
22−--
23−data ParseState = ParseState {
24− -- |
25− -- The most recently marked indentation level
26− --
27− indentationLevel :: P.Column
28− } deriving Show
29−
30−
src/Language/PureScript/Parser/Types.hsdeleted−137

This diff is too big to show here.

src/Language/PureScript/Pretty.hsdeleted−32

This diff is too big to show here.

src/Language/PureScript/Pretty/Common.hsdeleted−69

This diff is too big to show here.

src/Language/PureScript/Pretty/JS.hsdeleted−301

This diff is too big to show here.

src/Language/PureScript/Pretty/Kinds.hsdeleted−59

This diff is too big to show here.

src/Language/PureScript/Pretty/Types.hsdeleted−127

This diff is too big to show here.

src/Language/PureScript/Pretty/Values.hsdeleted−242

This diff is too big to show here.

src/Language/PureScript/Renamer.hsdeleted−196

This diff is too big to show here.

src/Language/PureScript/Sugar.hsdeleted−71

This diff is too big to show here.

src/Language/PureScript/Sugar/BindingGroups.hsdeleted−206

This diff is too big to show here.

src/Language/PureScript/Sugar/CaseDeclarations.hsdeleted−180

This diff is too big to show here.

src/Language/PureScript/Sugar/DoNotation.hsdeleted−74

This diff is too big to show here.

src/Language/PureScript/Sugar/Names.hsdeleted−542

This diff is too big to show here.

src/Language/PureScript/Sugar/ObjectWildcards.hsdeleted−65

This diff is too big to show here.

src/Language/PureScript/Sugar/Operators.hsdeleted−166

This diff is too big to show here.

src/Language/PureScript/Sugar/TypeClasses.hsdeleted−297

This diff is too big to show here.

src/Language/PureScript/Sugar/TypeDeclarations.hsdeleted−69

This diff is too big to show here.

src/Language/PureScript/Traversals.hsdeleted−41

This diff is too big to show here.

src/Language/PureScript/TypeChecker.hsdeleted−347

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Entailment.hsdeleted−212

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Kinds.hsdeleted−218

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Monad.hsdeleted−266

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Rows.hsdeleted−67

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Skolems.hsdeleted−114

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Subsumption.hsdeleted−96

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Synonyms.hsdeleted−112

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Types.hsdeleted−675

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Unify.hsdeleted−206

This diff is too big to show here.

src/Language/PureScript/TypeClassDictionaries.hsdeleted−96

This diff is too big to show here.

src/Language/PureScript/Types.hsdeleted−305

This diff is too big to show here.

src/Tests.hsnew file+141

This diff is too big to show here.

stack.nixnew file+23

This diff is too big to show here.

stack.yamlnew file+24

This diff is too big to show here.

support/ffi-loader.gonew file+30

This diff is too big to show here.

support/go.mod.ffi-loadernew file+2

This diff is too big to show here.

support/go.mod.outputnew file+2

This diff is too big to show here.

support/go.mod.workingnew file+1

This diff is too big to show here.

test/Spec.hsnew file+2

This diff is too big to show here.

tests/Main.hsdeleted−109

This diff is too big to show here.

tests/prelude.pursdeleted−1068

This diff is too big to show here.

travis-after-script.shdeleted−21

This diff is too big to show here.

travis-script.shdeleted−17

This diff is too big to show here.