git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
swap
355eb9b1282 ahead, 0 behind
456 files changed+2707−28528
since splitsnapshots
unifiedsplit
.gitignore+6−1 .gitmodules−3 .travis.yml−83 CONTRIBUTING.md−44 CONTRIBUTORS.md−66 ChangeLog.md+3 INSTALL.md−57 LICENSE+24−2129 README-go.md+48 README.md+32−20 Setup.hs−4 app/Main.hs+250 bundle/.gitignore−4 bundle/README−21 bundle/build.sh−46 bundle/winbuild.sh−43 core-tests/.gitignore−2 core-tests/test-everything.sh−77 core-tests/tests/generic-deriving/Main.purs−27 default.nix+23 examples/.gitignore−1 examples/failing/1071.purs−8 examples/failing/1169.purs−12 examples/failing/1175.purs−11 examples/failing/1310.purs−18 examples/failing/1570.purs−6 examples/failing/1733.purs−13 examples/failing/365.purs−14 examples/failing/438.purs−15 examples/failing/881.purs−13 examples/failing/ArrayType.purs−14 examples/failing/Arrays.purs−8 examples/failing/CaseBinderLengthsDiffer.purs−6 examples/failing/CaseDoesNotMatchAllConstructorArgs.purs−15 examples/failing/ConflictingExports.purs−16 examples/failing/ConflictingExports2.purs−13 examples/failing/ConflictingImports.purs−19 examples/failing/ConflictingImports2.purs−16 examples/failing/ConflictingQualifiedImports.purs−17 examples/failing/ConflictingQualifiedImports2.purs−15 examples/failing/Do.purs−12 examples/failing/DoNotSuggestComposition.purs−13 examples/failing/DoNotSuggestComposition2.purs−7 examples/failing/DuplicateDeclarationsInLet.purs−12 examples/failing/DuplicateProperties1.purs−12 examples/failing/DuplicateProperties2.purs−12 examples/failing/DuplicateTypeVars.purs−6 examples/failing/Eff.purs−13 examples/failing/EmptyCase.purs−4 examples/failing/EmptyClass.purs−7 examples/failing/EmptyDo.purs−6 examples/failing/ExtraRecordField.purs−9 examples/failing/Foldable.purs−17 examples/failing/ImportHidingModule.purs−10 examples/failing/InfiniteKind.purs−5 examples/failing/InfiniteType.purs−5 examples/failing/InstanceExport.purs−19 examples/failing/IntOutOfRange.purs−6 examples/failing/KindError.purs−6 examples/failing/KindStar.purs−8 examples/failing/LeadingZeros1.purs−6 examples/failing/LeadingZeros2.purs−6 examples/failing/Let.purs−6 examples/failing/MPTCs.purs−10 examples/failing/MissingClassExport.purs−7 examples/failing/MissingClassMemberExport.purs−7 examples/failing/MissingRecordField.purs−10 examples/failing/MultipleErrors.purs−13 examples/failing/MultipleErrors2.purs−9 examples/failing/MutRec.purs−9 examples/failing/MutRec2.purs−6 examples/failing/NewtypeMultiArgs.purs−6 examples/failing/NewtypeMultiCtor.purs−6 examples/failing/NullaryAbs.purs−6 examples/failing/Object.purs−8 examples/failing/OperatorAliasNoExport.purs−7 examples/failing/OrphanInstance.purs−12 examples/failing/OverlappingArguments.purs−6 examples/failing/OverlappingBinders.purs−9 examples/failing/OverlappingReExport.purs−10 examples/failing/OverlappingVars.purs−15 examples/failing/Rank2Types.purs−8 examples/failing/Reserved.purs−7 examples/failing/RowConstructors1.purs−9 examples/failing/RowConstructors2.purs−9 examples/failing/RowConstructors3.purs−9 examples/failing/SkolemEscape.purs−8 examples/failing/SkolemEscape2.purs−10 examples/failing/SuggestComposition.purs−7 examples/failing/Superclasses1.purs−14 examples/failing/Superclasses2.purs−13 examples/failing/Superclasses3.purs−8 examples/failing/Superclasses5.purs−25 examples/failing/TopLevelCaseNoArgs.purs−8 examples/failing/TransitiveDctorExport.purs−5 examples/failing/TransitiveSynonymExport.purs−5 examples/failing/TypeClassInstances.purs−11 examples/failing/TypeClasses2.purs−9 examples/failing/TypeError.purs−6 examples/failing/TypeSynonyms.purs−8 examples/failing/TypeSynonyms2.purs−12 examples/failing/TypeSynonyms3.purs−12 examples/failing/TypeSynonyms4.purs−11 examples/failing/TypeSynonyms5.purs−6 examples/failing/TypeWildcards1.purs−7 examples/failing/TypeWildcards2.purs−7 examples/failing/TypeWildcards3.purs−10 examples/failing/TypedBinders.purs−10 examples/failing/TypedBinders2.purs−9 examples/failing/TypedBinders3.purs−12 examples/failing/UnderscoreModuleName.purs−6 examples/failing/UnifyInTypeInstanceLookup.purs−22 examples/failing/UnknownType.purs−7 examples/manual/QualifiedNames.purs−13 examples/manual/failing/ArgLengthMismatch.purs−6 examples/manual/failing/ExportExplicit.purs−7 examples/manual/failing/ExportExplicit1.purs−14 examples/manual/failing/ExportExplicit2.purs−7 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−8 examples/manual/failing/RequiredHiddenType.purs−8 examples/manual/passing/ExportExplicit.purs−20 examples/manual/passing/ExportExplicit2.purs−15 examples/manual/passing/ExportedInstanceDeclarations.purs−43 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−24 examples/manual/passing/WildcardType.purs−13 examples/passing/1185.purs−13 examples/passing/1335.purs−12 examples/passing/1570.purs−6 examples/passing/1664.purs−16 examples/passing/1697.purs−24 examples/passing/652.purs−17 examples/passing/810.purs−13 examples/passing/862.purs−8 examples/passing/922.purs−20 examples/passing/Applicative.purs−16 examples/passing/ArrayType.purs−11 examples/passing/Auto.purs−15 examples/passing/AutoPrelude.purs−9 examples/passing/AutoPrelude2.purs−10 examples/passing/BindersInFunctions.purs−11 examples/passing/BindingGroups.purs−10 examples/passing/BlockString.purs−8 examples/passing/CaseInDo.purs−19 examples/passing/CaseMultipleExpressions.purs−19 examples/passing/CaseStatement.purs−21 examples/passing/CheckFunction.purs−7 examples/passing/CheckSynonymBug.purs−12 examples/passing/CheckTypeClass.purs−18 examples/passing/Church.purs−18 examples/passing/ClassRefSyntax.purs−13 examples/passing/Collatz.purs−18 examples/passing/Comparisons.purs−15 examples/passing/Conditional.purs−9 examples/passing/Console.purs−13 examples/passing/DataAndType.purs−9 examples/passing/DeepArrayBinder.purs−16 examples/passing/DeepCase.purs−15 examples/passing/Do.purs−67 examples/passing/Dollar.purs−16 examples/passing/Eff.purs−25 examples/passing/EmptyDataDecls.purs−19 examples/passing/EmptyRow.purs−10 examples/passing/EmptyTypeClass.purs−12 examples/passing/EqOrd.purs−15 examples/passing/ExplicitImportReExport.purs−16 examples/passing/ExtendedInfixOperators.purs−14 examples/passing/Fib.purs−15 examples/passing/FieldConsPuns.purs−10 examples/passing/FieldPuns.purs−8 examples/passing/FinalTagless.purs−22 examples/passing/FunctionScope.purs−12 examples/passing/Functions.purs−15 examples/passing/Functions2.purs−12 examples/passing/Guards.purs−29 examples/passing/HoistError.purs−12 examples/passing/IfThenElseMaybe.purs−11 examples/passing/ImplicitEmptyImport.purs−8 examples/passing/ImportHiding.purs−18 examples/passing/InferRecFunWithConstrainedArgument.purs−8 examples/passing/InstanceBeforeClass.purs−11 examples/passing/IntAndChar.purs−18 examples/passing/JSReserved.purs−12 examples/passing/KindedType.purs−33 examples/passing/LargeSumType.purs−33 examples/passing/Let.purs−53 examples/passing/Let2.purs−17 examples/passing/LetInInstance.purs−14 examples/passing/LiberalTypeSynonyms.purs−21 examples/passing/MPTCs.purs−20 examples/passing/Match.purs−9 examples/passing/ModuleExport.purs−9 examples/passing/ModuleExportDupes.purs−19 examples/passing/ModuleExportExcluded.purs−14 examples/passing/ModuleExportQualified.purs−9 examples/passing/ModuleExportSelf.purs−14 examples/passing/Monad.purs−32 examples/passing/MonadState.purs−48 examples/passing/MultiArgFunctions.purs−27 examples/passing/MutRec.purs−19 examples/passing/MutRec2.purs−19 examples/passing/MutRec3.purs−19 examples/passing/NakedConstraint.purs−10 examples/passing/NamedPatterns.purs−9 examples/passing/NegativeBinder.purs−9 examples/passing/NegativeIntInRange.purs−8 examples/passing/Nested.purs−9 examples/passing/NestedTypeSynonyms.purs−11 examples/passing/NestedWhere.purs−12 examples/passing/Newtype.purs−23 examples/passing/NewtypeEff.purs−29 examples/passing/NewtypeWithRecordUpdate.purs−16 examples/passing/NonConflictingExports.purs−14 examples/passing/ObjectGetter.purs−13 examples/passing/ObjectSynonym.purs−15 examples/passing/ObjectUpdate.purs−20 examples/passing/ObjectUpdate2.purs−17 examples/passing/ObjectUpdater.purs−24 examples/passing/ObjectWildcards.purs−20 examples/passing/Objects.purs−35 examples/passing/OneConstructor.purs−9 examples/passing/OperatorAlias.purs−11 examples/passing/OperatorAliasElsewhere.purs−14 examples/passing/OperatorAssociativity.purs−25 examples/passing/OperatorInlining.purs−47 examples/passing/OperatorSections.purs−17 examples/passing/Operators.purs−99 examples/passing/OptimizerBug.purs−9 examples/passing/OptionalQualified.purs−13 examples/passing/OverlappingInstances.purs−13 examples/passing/OverlappingInstances2.purs−23 examples/passing/OverlappingInstances3.purs−16 examples/passing/PartialFunction.purs−10 examples/passing/Patterns.purs−22 examples/passing/PendingConflictingImports.purs−17 examples/passing/PendingConflictingImports2.purs−14 examples/passing/Person.purs−11 examples/passing/QualifiedQualifiedImports.purs−6 examples/passing/Rank2Data.purs−29 examples/passing/Rank2Object.purs−11 examples/passing/Rank2TypeSynonym.purs−16 examples/passing/Rank2Types.purs−11 examples/passing/ReExportQualified.purs−16 examples/passing/RebindableSyntax.purs−39 examples/passing/Recursion.purs−10 examples/passing/ReservedWords.purs−15 examples/passing/RowConstructors.purs−42 examples/passing/RowPolyInstanceContext.purs−22 examples/passing/RuntimeScopeIssue.purs−19 examples/passing/ScopedTypeVariables.purs−36 examples/passing/Sequence.purs−15 examples/passing/SequenceDesugared.purs−37 examples/passing/ShadowedModuleName.purs−15 examples/passing/ShadowedRename.purs−14 examples/passing/ShadowedTCO.purs−18 examples/passing/ShadowedTCOLet.purs−9 examples/passing/SignedNumericLiterals.purs−17 examples/passing/StringEscapes.purs−15 examples/passing/Superclasses1.purs−20 examples/passing/Superclasses3.purs−41 examples/passing/TCOCase.purs−12 examples/passing/TailCall.purs−17 examples/passing/Tick.purs−7 examples/passing/TopLevelCase.purs−18 examples/passing/TypeClassMemberOrderChange.purs−13 examples/passing/TypeClasses.purs−69 examples/passing/TypeClassesInOrder.purs−11 examples/passing/TypeClassesWithOverlappingTypeVariables.purs−11 examples/passing/TypeDecl.purs−12 examples/passing/TypeSynonymInData.purs−11 examples/passing/TypeSynonyms.purs−27 examples/passing/TypeWildcards.purs−15 examples/passing/TypeWildcardsRecordExtension.purs−8 examples/passing/TypeWithoutParens.purs−16 examples/passing/TypedBinders.purs−67 examples/passing/TypedWhere.purs−17 examples/passing/UTF8Sourcefile.purs−10 examples/passing/UnderscoreIdent.purs−11 examples/passing/UnicodeIdentifier.purs−5 examples/passing/UnicodeOperators.purs−20 examples/passing/Unit.purs−6 examples/passing/UnknownInTypeClassLookup.purs−14 examples/passing/UntupledConstraints.purs−17 examples/passing/Where.purs−49 examples/passing/iota.purs−9 examples/passing/s.purs−7 hierarchy/Main.hs−115 license-generator/generate.hs−40 license-generator/header.txt−23 logo.png make_release_notes−2 package.yaml+86 psc-bundle/Main.hs−146 psc-bundle/README.md−18 psc-docs/Ctags.hs−13 psc-docs/Etags.hs−13 psc-docs/Main.hs−245 psc-docs/Tags.hs−18 psc-publish/Main.hs−45 psc/JSON.hs−69 psc/Main.hs−207 psci/Completion.hs−226 psci/Directive.hs−115 psci/IO.hs−21 psci/PSCi.hs−688 psci/Parser.hs−140 psci/Types.hs−215 psci/main/Main.hs−6 psci/tests/Main.hs−162 psci/tests/data/Sample.purs psgo.cabal+145 purescript.cabal−289 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/Logger.hs−72 src/Control/Monad/Supply.hs−45 src/Control/Monad/Supply/Class.hs−24 src/Language/PureScript.hs−48 src/Language/PureScript/AST.hs−24 src/Language/PureScript/AST/Binders.hs−81 src/Language/PureScript/AST/Declarations.hs−473 src/Language/PureScript/AST/Exported.hs−154 src/Language/PureScript/AST/Operators.hs−62 src/Language/PureScript/AST/SourcePos.hs−96 src/Language/PureScript/AST/Traversals.hs−517 src/Language/PureScript/Bundle.hs−552 src/Language/PureScript/CodeGen.hs−20 src/Language/PureScript/CodeGen/JS.hs−435 src/Language/PureScript/CodeGen/JS/AST.hs−345 src/Language/PureScript/CodeGen/JS/Common.hs−231 src/Language/PureScript/CodeGen/JS/Optimizer.hs−91 src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs−42 src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs−78 src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs−316 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−29 src/Language/PureScript/Constants.hs−292 src/Language/PureScript/CoreFn.hs−26 src/Language/PureScript/CoreFn/Ann.hs−37 src/Language/PureScript/CoreFn/Binders.hs−37 src/Language/PureScript/CoreFn/Desugar.hs−265 src/Language/PureScript/CoreFn/Expr.hs−123 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/Crash.hs−9 src/Language/PureScript/Docs.hs−14 src/Language/PureScript/Docs/AsMarkdown.hs−125 src/Language/PureScript/Docs/Convert.hs−231 src/Language/PureScript/Docs/ParseAndDesugar.hs−129 src/Language/PureScript/Docs/Render.hs−133 src/Language/PureScript/Docs/RenderedCode.hs−11 src/Language/PureScript/Docs/RenderedCode/Render.hs−188 src/Language/PureScript/Docs/RenderedCode/Types.hs−197 src/Language/PureScript/Docs/Types.hs−527 src/Language/PureScript/Docs/Utils/MonoidExtras.hs−9 src/Language/PureScript/Environment.hs−274 src/Language/PureScript/Errors.hs−1189 src/Language/PureScript/Externs.hs−206 src/Language/PureScript/Kinds.hs−72 src/Language/PureScript/Linter.hs−113 src/Language/PureScript/Linter/Exhaustive.hs−310 src/Language/PureScript/Linter/Imports.hs−174 src/Language/PureScript/Make.hs−362 src/Language/PureScript/ModuleDependencies.hs−81 src/Language/PureScript/Names.hs−142 src/Language/PureScript/Options.hs−49 src/Language/PureScript/Parser.hs−36 src/Language/PureScript/Parser/Common.hs−122 src/Language/PureScript/Parser/Declarations.hs−568 src/Language/PureScript/Parser/JS.hs−60 src/Language/PureScript/Parser/Kinds.hs−48 src/Language/PureScript/Parser/Lexer.hs−520 src/Language/PureScript/Parser/State.hs−30 src/Language/PureScript/Parser/Types.hs−114 src/Language/PureScript/Pretty.hs−32 src/Language/PureScript/Pretty/Common.hs−80 src/Language/PureScript/Pretty/JS.hs−311 src/Language/PureScript/Pretty/Kinds.hs−59 src/Language/PureScript/Pretty/Types.hs−151 src/Language/PureScript/Pretty/Values.hs−174 src/Language/PureScript/Publish.hs−371 src/Language/PureScript/Publish/BoxesHelpers.hs−38 src/Language/PureScript/Publish/ErrorsWarnings.hs−384 src/Language/PureScript/Publish/Utils.hs−38 src/Language/PureScript/Renamer.hs−197 src/Language/PureScript/Sugar.hs−78 src/Language/PureScript/Sugar/BindingGroups.hs−227 src/Language/PureScript/Sugar/CaseDeclarations.hs−200 src/Language/PureScript/Sugar/DoNotation.hs−65 src/Language/PureScript/Sugar/Names.hs−342 src/Language/PureScript/Sugar/Names/Env.hs−220 src/Language/PureScript/Sugar/Names/Exports.hs−276 src/Language/PureScript/Sugar/Names/Imports.hs−310 src/Language/PureScript/Sugar/ObjectWildcards.hs−53 src/Language/PureScript/Sugar/Operators.hs−183 src/Language/PureScript/Sugar/TypeClasses.hs−334 src/Language/PureScript/Sugar/TypeClasses/Deriving.hs−246 src/Language/PureScript/Sugar/TypeDeclarations.hs−73 src/Language/PureScript/Traversals.hs−42 src/Language/PureScript/TypeChecker.hs−441 src/Language/PureScript/TypeChecker/Entailment.hs−168 src/Language/PureScript/TypeChecker/Kinds.hs−271 src/Language/PureScript/TypeChecker/Monad.hs−255 src/Language/PureScript/TypeChecker/Rows.hs−72 src/Language/PureScript/TypeChecker/Skolems.hs−142 src/Language/PureScript/TypeChecker/Subsumption.hs−102 src/Language/PureScript/TypeChecker/Synonyms.hs−63 src/Language/PureScript/TypeChecker/Types.hs−741 src/Language/PureScript/TypeChecker/Unify.hs−228 src/Language/PureScript/TypeClassDictionaries.hs−48 src/Language/PureScript/Types.hs−302 src/System/IO/UTF8.hs−25 src/Tests.hs+141 stack-lts-2.yaml−9 stack-lts-3.yaml−5 stack-nightly.yaml−5 stack.nix+23 stack.yaml+24−1 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−226 tests/TestPscPublish.hs−65 tests/common/TestsSetup.hs−45 tests/support/.gitignore−2 tests/support/bower.json−11 tests/support/package.json−7 tests/support/prelude−1 tests/support/setup-win.cmd−3 tests/support/setup.js−22 travis/after.sh−25 travis/configure.sh−17 travis/test-install.sh−18
.gitignore+6−1
@@ -14,5 +14,10 @@ bower_components/
1414node_modules
1515tmp/
1616.stack-work/
17−tests/support/flattened/
17+stack.yaml.lock
1818output
19+examples/docs/docs/
20+core-tests/full-core-docs.md
21+.psc-ide-port
22+.vscode/
23+result
.gitmodulesdeleted−3
@@ -1,3 +0,0 @@
1−[submodule "tests/support/prelude"]
2− path = tests/support/prelude
3− url = https://github.com/purescript/purescript-prelude
.travis.ymldeleted−83
@@ -1,83 +0,0 @@
1−language: c
2−sudo: false
3−matrix:
4− include:
5− - env: GHCVER=7.8.4 COVERAGE_SUITE=tests
6− compiler: ": #GHC 7.8.4 - tests"
7− # ^ HACK before https://github.com/travis-ci/travis-ci/issues/4393 is resolved
8− addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
9− - env: GHCVER=7.8.4 COVERAGE_SUITE=psci-tests
10− compiler: ": #GHC 7.8.4 - psci-tests"
11− addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
12− - env: GHCVER=7.8.4 STACKAGE=lts-2.22
13− compiler: ": #GHC 7.8.4 - lts-2.22-1"
14− addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
15− - env: GHCVER=7.6.3
16− compiler: ": #GHC 7.6.3"
17− addons: {apt: {packages: [cabal-install-1.22,ghc-7.6.3,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
18− - env: GHCVER=7.10.1 DEPLOY=yes
19− compiler: ": #GHC 7.10.1"
20− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
21− - env: GHCVER=7.10.2 STACKAGE=lts=3.6 RUNSDISTTESTS=YES
22− compiler: ": #GHC 7.10.2 lts-3.6"
23− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
24− - env: GHCVER=7.10.2 STACKAGE=nightly-2015-09-29
25− compiler: ": #GHC 7.10.2 nightly-2015-09-29"
26− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
27− - env: GHCVER=7.10.3
28− compiler: ": #GHC 7.10.3"
29− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
30−before_install:
31− - unset CC
32− - export PATH="/opt/ghc/$GHCVER/bin:$PATH"
33− - export PATH="/opt/cabal/1.22/bin:$PATH"
34− - export PATH="$HOME/.cabal/bin:$PATH"
35− - export PATH="/opt/happy/1.19.5/bin:/$PATH"
36− - export PATH="/opt/alex/3.1.4/bin:/$PATH"
37−install:
38− - cabal --version
39− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
40− - travis_retry cabal update
41− # Run sequentially
42− # Travis container infrastructure seems to expose all host CPUs (16?), thus
43− # cabal and ghc tries to use them all. Which is bad idea on a shared box.
44− # See also: https://ghc.haskell.org/trac/ghc/ticket/9221
45− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
46− # Cache sandboxes in ~/cabal-sandboxes
47− # Move right sandbox to .cabal-sandbox if exists
48− - if [ -d ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none} ]; then
49− mv ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none} .cabal-sandbox;
50− fi
51− - mkdir -p .cabal-sandbox
52− - cabal sandbox init --sandbox .cabal-sandbox
53− # Download stackage cabal.config, not sure whether filtering is necessary
54− - if [ -n "$STACKAGE" ]; then curl http://www.stackage.org/$STACKAGE/cabal.config | grep -v purescript > cabal.config; fi
55− - cabal install --only-dependencies --enable-tests
56− - cabal install hpc-coveralls
57− # Snapshot state of the sandbox now, so we don't need to make new one for test install
58− - rm -rf ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
59− - cp -r .cabal-sandbox ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
60−script:
61− - ./travis/configure.sh
62− - cabal build --ghc-options="-Werror"
63− - cabal test
64− - ./travis/test-install.sh
65−after_script:
66− - ./travis/after.sh
67−notifications:
68− email: true
69−before_deploy: "./bundle/build.sh linux64"
70−deploy:
71− provider: releases
72− api_key: $RELEASE_KEY
73− file:
74− - bundle/linux64.tar.gz
75− - bundle/linux64.sha
76− skip_cleanup: true
77− on:
78− all_branches: true
79− tags: true
80− condition: "$DEPLOY = yes"
81−cache:
82− directories:
83− - ~/cabal-sandboxes
CONTRIBUTING.mddeleted−44
@@ -1,44 +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−## Finding Issues to Work On
6−
7−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.
8−
9−## Pull Requests
10−
11−Please follow the following guidelines:
12−
13−- Add at least a test to `examples/passing/` and possibly to `examples/failing`.
14−- Build the binaries and libs with `cabal build`
15−- Install the binaries and libs with `cabal install`.
16−- Run `cabal configure --enable-tests && cabal build && cabal test` to build the test suite. You will need `npm` and `node` on your PATH to run the tests.
17−- Build the core libraries by running the script in `core-tests`.
18−
19−## Code Review
20−
21−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.
22−
23−## Adding Dependencies
24−
25−Because the PureScript compiler is distributed in binary form, we include
26−the licenses of all dependencies, including transitive ones, in the LICENSE
27−file. Therefore, whenever the dependencies change, the LICENSE file should be
28−updated.
29−
30−You can automate this (if you have bash):
31−
32−- get a copy of [cabal-dependency-licenses][]
33−- run at the command line: `runhaskell license-generator/generate.hs > LICENSE`
34−
35−[cabal-dependency-licenses]: https://github.com/jaspervdj/cabal-dependency-licenses
36−
37−## Writing Issues
38−
39−- If the issue is actually a question, please consider asking on Reddit, Stack Overflow or IRC first.
40−- Please include a minimal, repeatable test case with any bug report.
41−
42−## Copyright and Licensing
43−
44−For any code change, please append a copyright and licensing notice to the [CONTRIBUTORS.md](CONTRIBUTORS.md) file.
CONTRIBUTORS.mddeleted−66
@@ -1,66 +0,0 @@
1−## Contributors
2−
3−This file lists the contributors to the PureScript compiler project, and the terms under which their code is licensed.
4−
5−### Individuals
6−
7−- [@5outh](https://github.com/5outh) (Benjamin Kovach) - My existing contributions and all future contributions until further notice are Copyright Benjamin Kovach, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
8−- [@andyarvanitis](https://github.com/andyarvanitis) (Andy Arvanitis) My existing contributions and all future contributions until further notice are Copyright Andy Arvanitis, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
9−- [@anthok88](https://github.com/anthoq88) - My existing contributions and all future contributions until further notice are Copyright anthoq88, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license
10−- [@ardumont](https://github.com/ardumont) (Antoine R. Dumont) My existing contributions and all future contributions until further notice are Copyright Antoine R. Dumont, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
11−- [@aspidites](https://github.com/aspidites) (Edwin Marshall) My existing contributions and all future contributions until further notice are Copyright Edwin Marshall, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
12−- [@balajirrao](https://github.com/balajirrao) (Balaji Rao) - My existing contributions and all future contributions until further notice are Copyright Balaji Rao, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
13−- [@bergmark](https://github.com/bergmark) (Adam Bergmark) - My existing contributions and all future contributions until further notice are Copyright Adam Bergmark, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
14−- [@Bogdanp](https://github.com/Bogdanp) (Bogdan Paul Popa) My existing contributions and all future contributions until further notice are Copyright Bogdan Paul Popa, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
15−- [@davidchambers](https://github.com/davidchambers) (David Chambers) My existing contributions and all future contributions until further notice are Copyright David Chambers, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
16−- [@dckc](https://github.com/dckc) (Dan Connolly) My existing contributions and all future contributions until further notice are Copyright Dan Connolly, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
17−- [@dylex](https://github.com/dylex) (Dylan Simon) My existing and all future contributions to the PureScript compiler until further notice are Copyright Dylan Simon, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
18−- [@eamelink](https://github.com/eamelink) (Erik Bakker) - My existing contributions and all future contributions until further notice are Copyright Erik Bakker, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
19−- [@epost](https://github.com/epost) (Erik Post) - My existing contributions and all future contributions until further notice are Copyright Erik Post, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license
20−- [@erdeszt](https://github.com/erdeszt) (Tibor Erdesz) My existing contributions and all future contributions until further notice are Copyright Tibor Erdesz, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
21−- [@etrepum](https://github.com/etrepum) (Bob Ippolito) My existing contributions and all future contributions until further notice are Copyright Bob Ippolito, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
22−- [@garyb](https://github.com/garyb) (Gary Burgess) My existing contributions and all future contributions until further notice are Copyright Gary Burgess, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
23−- [@hdgarrood](https://github.com/hdgarrood) (Harry Garrood) My existing contributions and all future contributions until further notice are Copyright Harry Garrood, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
24−- [@jacereda](https://github.com/jacereda) (Jorge Acereda) My existing contributions and all future contributions until further notice are Copyright Jorge Acereda, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
25−- [@japesinator](https://github.com/japesinator) (JP Smith) My existing contributions and all future contributions until further notice are Copyright JP Smith, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
26−- [@joneshf](https://github.com/joneshf) (Hardy Jones) - My existing contributions and all future contributions until further notice are Copyright Hardy Jones, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
27−- [@kRITZCREEK](https://github.com/kRITZCREEK) (Christoph Hegemann) - My existing contributions and all future contributions until further notice are Copyright Christoph Hegemann, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
28−- [@L8D](https://github.com/L8D) (Tenor Biel) My existing contributions and all future contributions until further notice are Copyright Tenor Biel, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
29−- [@leighman](http://github.com/leighman) (Jack Leigh) My existing contributions and all future contributions until further notice are Copyright Jack Leigh, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
30−- [@lukerandall](https://github.com/lukerandall) (Luke Randall) My existing contributions and all future contributions until further notice are Copyright Luke Randall, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
31−- [@mgmeier](https://github.com/mgmeier) (Michael Karg) My existing contributions and all future contributions until further notice are Copyright Michael Gilliland, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
32−- [@michaelficarra](https://github.com/michaelficarra) (Michael Ficarra) My existing contributions and all future contributions until further notice are Copyright Michael Ficarra, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
33−- [@MichaelXavier](https://github.com/MichaelXavier) (Michael Xavier) - My existing contributions and all future contributions until further notice are Copyright Michael Xavier, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
34−- [@mjgpy3](https://github.com/mjgpy3) (Michael Gilliland) My existing contributions and all future contributions until further notice are Copyright Michael Gilliland, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
35−- [@mpietrzak](https://github.com/mpietrzak) (Maciej Pietrzak) My existing contributions and all future contributions until further notice are Copyright Maciej Pietrzak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
36−- [@mrhania](https://github.com/mrhania) (Łukasz Hanuszczak) - My existing contributions and all future contributions until further notice are Copyright Łukasz Hanuszczak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
37−- [@nagisa](https://github.com/nagisa) I hereby release my [only contribution](https://github.com/purescript/purescript/commit/80287a5d0de619862d3b4cda9c1ee276d18fdcd8) into public domain.
38−- [@natefaubion](https://github.com/natefaubion) (Nathan Faubion) My existing contributions and all future contributions until further notice are Copyright Nathan Faubion, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
39−- [@nicodelpiano](https://github.com/nicodelpiano) (Nicolas Del Piano) My existing contributions and all future contributions until further notice are Copyright Nicolas Del Piano, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
40−- [@nullobject](https://github.com/nullobject) (Josh Bassett) My existing contributions and all future contributions until further notice are Copyright Josh Bassett, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
41−- [@nwolverson](https://github.com/nwolverson) (Nicholas Wolverson) My existing contributions and all future contributions until further notice are Copyright Nicholas Wolverson, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
42−- [@osa1](https://github.com/osa1) (Ömer Sinan Ağacan) - My existing contributions and all future contributions until further notice are Copyright Ömer Sinan Ağacan, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
43−- [@paf31](https://github.com/paf31) (Phil Freeman) My existing contributions and all future contributions until further notice are Copyright Phil Freeman, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
44−- [@paulyoung](https://github.com/paulyoung) (Paul Young) My existing contributions and all future contributions until further notice are Copyright Paul Young, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
45−- [@pelotom](https://github.com/pelotom) (Thomas Crockett) My existing contributions and all future contributions until further notice are Copyright Thomas Crockett, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
46−- [@phadej](https://github.com/phadej) (Oleg Grenrus) My existing contributions and all future contributions until further notice are Copyright Oleg Grenrus, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
47−- [@philopon](https://github.com/philopon) (Hirotomo Moriwaki) - My existing contributions and all future contributions until further notice are Copyright Hirotomo Moriwaki, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
48−- [@pseudonom](https://github.com/pseudonom) (Eric Easley) My existing contributions and all future contributions until further notice are Copyright Eric Easley, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
49−- [@puffnfresh](https://github.com/puffnfresh) (Brian McKenna) All contributions I made during June 2015 were during employment at [SlamData, Inc.](#companies) who owns the copyright. I assign copyright of all my personal contributions before June 2015 to the owners of the PureScript compiler.
50−- [@robdaemon](https://github.com/robdaemon) (Robert Roland) My existing contributions and all future contributions until further notice are Copyright Robert Roland, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
51−- [@RossMeikleham](https://github.com/RossMeikleham) (Ross Meikleham) My existing contributions and all future contributions until further notice are Copyright Ross Meikleham, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
52−- [@sebastiaanvisser](https://github.com/sebastiaanvisser) (Sebastiaan Visser) - My existing contributions and all future contributions until further notice are Copyright Sebastiaan Visser, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
53−- [@sztupi](https://github.com/sztupi) (Attila Sztupak) My existing contributions and all future contributions until further notice are Copyright Attila Sztupak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
54−- [@taku0](https://github.com/taku0) - My existing contributions and all future contributions until further notice are Copyright taku0, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
55−- [@trofi](https://github.com/trofi) (Sergei Trofimovich) My existing contributions and all future contributions until further notice are Copyright Sergei Trofimovich, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
56−- [@utkarshkukreti](https://github.com/utkarshkukreti) (Utkarsh Kukreti) My existing contributions and all future contributions until further notice are Copyright Utkarsh Kukreti, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
57−- [@vkorablin](https://github.com/vkorablin) (Vladimir Korablin) - My existing contributions and all future contributions until further notice are Copyright Vladimir Korablin, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
58−- [@zudov](https://github.com/zudov) (Konstantin Zudov) My existing contributions and all future contributions until further notice are Copyright Konstantin Zudov, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
59−- [@senju](https://github.com/senju) - My existing contributions and all future contributions until further notice are Copyright senju, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
60−<http://opensource.org/licenses/MIT>.
61−- [@soupi](https://github.com/soupi) (Gil Mizrahi) My existing contributions and all future contributions until further notice are Copyright Gil Mizrahi, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
62−- [@tfausak](https://github.com/tfausak) (Taylor Fausak) My existing contributions and all future contributions until further notice are Copyright Taylor Fausak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
63−
64−### Companies
65−
66−- [@slamdata](https://github.com/slamdata) (SlamData, Inc.) Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - @jdegoes
ChangeLog.mdnew file+3
@@ -0,0 +1,3 @@
1+# Changelog for pscpp
2+
3+## Unreleased changes
INSTALL.mddeleted−57
@@ -1,57 +0,0 @@
1−# Installation information
2−
3−If you are having difficulty installing the PureScript compiler, feel free to
4−ask for help! A good place is the #purescript IRC channel on Freenode, or
5−alternatively Stack Overflow.
6−
7−## Using prebuilt binaries
8−
9−The prebuilt binaries are compiled with GHC 7.8.4, and therefore they should
10−run on any operating system supported by GHC 7.8.4, such as:
11−
12−* Windows 2000 or later,
13−* OS X 10.7 or later,
14−* Linux ??? (we're not sure what the minimum version is).
15−
16−This list is not exhaustive. If your OS is too old or not listed, or if the
17−binaries fail to run, you may be able to install the compiler by building it
18−from source; see below.
19−
20−It's probably safe to assume that other prebuilt distributions (eg, Homebrew,
21−Chocolatey, AUR, npm) use the same binaries, and therefore have the same
22−requirements.
23−
24−## Compiling from source
25−
26−GHC 7.6.1 or newer is required to compile from source. The easiest way is to
27−use stack:
28−
29−```
30−$ stack install --resolver lts purescript
31−```
32−
33−This will then copy the compiler and utilities into `~/.local/bin`.
34−
35−
36−If you don't have stack installed yet there are install instructions
37−[here](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md).
38−
39−If you don't have ghc installed yet, stack will prompt you to run `stack setup`
40−which will install ghc for you.
41−
42−The PureScript compiler has been known to run on OS X 10.6 when built with GHC
43−7.6.
44−
45−
46−## The "curses" library
47−
48−`psci` depends on the `curses` library (via the Haskell package `terminfo`). If
49−you are having difficulty running the compiler, it may be because the `curses`
50−library is missing.
51−
52−On Linux, you will probably need to install `ncurses` manually. On Ubuntu, for
53−example, this can be done by running:
54−
55−```
56−$ sudo apt-get install libncurses5-dev
57−```
LICENSE+24−2129
@@ -1,2135 +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:
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.
24−
25− Glob
26− HUnit
27− aeson
28− aeson-better-errors
29− ansi-terminal
30− ansi-wl-pprint
31− array
32− attoparsec
33− base
34− base-compat
35− binary
36− blaze-builder
37− bower-json
38− boxes
39− bytestring
40− containers
41− deepseq
42− directory
43− dlist
44− filepath
45− ghc-prim
46− hashable
47− haskeline
48− integer-gmp
49− language-javascript
50− lifted-base
51− monad-control
52− mtl
53− nats
54− old-locale
55− optparse-applicative
56− parallel
57− parsec
58− pattern-arrows
59− pretty
60− primitive
61− process
62− rts
63− safe
64− scientific
65− semigroups
66− split
67− stm
68− syb
69− tagged
70− template-haskell
71− terminfo
72− text
73− time
74− transformers
75− transformers-base
76− transformers-compat
77− unix
78− unordered-containers
79− utf8-string
80− vector
81− void
82−
83−Glob LICENSE file:
84−
85− The code in Glob is released under the license below. Copyrights to parts of
86− the code are held by whoever wrote the code in question: see CREDITS.txt for a
87− list of authors.
88−
89− Copyright (c) 2008-2012 <authors>
90− All rights reserved.
91−
92− Redistribution and use in source and binary forms, with or without
93− modification, are permitted provided that the following conditions are met:
94− * Redistributions of source code must retain the above copyright
95− notice, this list of conditions and the following disclaimer.
96− * Redistributions in binary form must reproduce the above copyright
97− notice, this list of conditions and the following disclaimer in the
98− documentation and/or other materials provided with the distribution.
99− * Neither the name of the project nor the names of its contributors may be
100− used to endorse or promote products derived from this software without
101− specific prior written permission.
102−
103− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED
104− WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
105− MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
106− EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
107− INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
108− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
109− PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
110− LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
111− OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
112− ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
113−
114−HUnit LICENSE file:
115−
116− HUnit is Copyright (c) Dean Herington, 2002, all rights reserved,
117− and is distributed as free software under the following license.
118−
119− Redistribution and use in source and binary forms, with or without
120− modification, are permitted provided that the following conditions
121− are met:
122−
123− - Redistributions of source code must retain the above copyright
124− notice, this list of conditions, and the following disclaimer.
125−
126− - Redistributions in binary form must reproduce the above copyright
127− notice, this list of conditions, and the following disclaimer in the
128− documentation and/or other materials provided with the distribution.
129−
130− - The names of the copyright holders may not be used to endorse or
131− promote products derived from this software without specific prior
132− written permission.
133−
134− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
135− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
136− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
137− PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
138− LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
139− CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
140− SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
141− BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
142− WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
143− OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
144− IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
145−
146−aeson LICENSE file:
147−
148− Copyright (c) 2011, MailRank, Inc.
149−
150− All rights reserved.
151−
152− Redistribution and use in source and binary forms, with or without
153− modification, are permitted provided that the following conditions
154− are met:
155−
156− 1. Redistributions of source code must retain the above copyright
157− notice, this list of conditions and the following disclaimer.
158−
159− 2. Redistributions in binary form must reproduce the above copyright
160− notice, this list of conditions and the following disclaimer in the
161− documentation and/or other materials provided with the distribution.
162−
163− 3. Neither the name of the author nor the names of his contributors
164− may be used to endorse or promote products derived from this software
165− without specific prior written permission.
166−
167− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
168− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
169− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
170− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
171− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
172− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
173− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
174− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
175− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
176− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
177− POSSIBILITY OF SUCH DAMAGE.
178−
179−aeson-better-errors LICENSE file:
180−
181− Copyright (c) 2015 Harry Garrood
182−
183− Permission is hereby granted, free of charge, to any person obtaining
184− a copy of this software and associated documentation files (the
185− "Software"), to deal in the Software without restriction, including
186− without limitation the rights to use, copy, modify, merge, publish,
187− distribute, sublicense, and/or sell copies of the Software, and to
188− permit persons to whom the Software is furnished to do so, subject to
189− the following conditions:
190−
191− The above copyright notice and this permission notice shall be included
192− in all copies or substantial portions of the Software.
193−
194− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
195− EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
196− MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
197− IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
198− CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
199− TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
200− SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
201−
202−ansi-terminal LICENSE file:
203−
204− Copyright (c) 2008, Maximilian Bolingbroke
205− All rights reserved.
206−
207− Redistribution and use in source and binary forms, with or without modification, are permitted
208− provided that the following conditions are met:
209−
210− * Redistributions of source code must retain the above copyright notice, this list of
211− conditions and the following disclaimer.
212− * Redistributions in binary form must reproduce the above copyright notice, this list of
213− conditions and the following disclaimer in the documentation and/or other materials
214− provided with the distribution.
215− * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to
216− endorse or promote products derived from this software without specific prior written permission.
217−
218− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
219− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
220− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
221− CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
222− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
223− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
224− IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
225− OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
226−
227−ansi-wl-pprint LICENSE file:
228−
229− Copyright 2008, Daan Leijen and Max Bolingbroke. All rights reserved.
230−
231− Redistribution and use in source and binary forms, with or without
232− modification, are permitted provided that the following conditions are
233− met:
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
2347
2358 * Redistributions of source code must retain the above copyright
2369 notice, this list of conditions and the following disclaimer.
23710
238− * Redistributions in binary form must reproduce the above copyright
239− notice, this list of conditions and the following disclaimer in
240− the documentation and/or other materials provided with the
241− distribution.
242−
243− This software is provided by the copyright holders "as is" and any
244− express or implied warranties, including, but not limited to, the
245− implied warranties of merchantability and fitness for a particular
246− purpose are disclaimed. In no event shall the copyright holders be
247− liable for any direct, indirect, incidental, special, exemplary, or
248− consequential damages (including, but not limited to, procurement of
249− substitute goods or services; loss of use, data, or profits; or
250− business interruption) however caused and on any theory of liability,
251− whether in contract, strict liability, or tort (including negligence
252− or otherwise) arising in any way out of the use of this software, even
253− if advised of the possibility of such damage.
254−
255−array LICENSE file:
256−
257− This library (libraries/base) is derived from code from several
258− sources:
259−
260− * Code from the GHC project which is largely (c) The University of
261− Glasgow, and distributable under a BSD-style license (see below),
262−
263− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
264− and freely redistributable (but see the full license for
265− restrictions).
266−
267− * Code from the Haskell Foreign Function Interface specification,
268− which is (c) Manuel M. T. Chakravarty and freely redistributable
269− (but see the full license for restrictions).
270−
271− The full text of these licenses is reproduced below. All of the
272− licenses are BSD-style or compatible.
273−
274− -----------------------------------------------------------------------------
275−
276− The Glasgow Haskell Compiler License
277−
278− Copyright 2004, The University Court of the University of Glasgow.
279− All rights reserved.
280−
281− Redistribution and use in source and binary forms, with or without
282− modification, are permitted provided that the following conditions are met:
283−
284− - Redistributions of source code must retain the above copyright notice,
285− this list of conditions and the following disclaimer.
286−
287− - Redistributions in binary form must reproduce the above copyright notice,
288− this list of conditions and the following disclaimer in the documentation
289− and/or other materials provided with the distribution.
290−
291− - Neither name of the University nor the names of its contributors may be
292− used to endorse or promote products derived from this software without
293− specific prior written permission.
294−
295− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
296− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
297− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
298− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
299− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
300− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
301− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
302− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
303− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
304− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
305− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
306− DAMAGE.
307−
308− -----------------------------------------------------------------------------
309−
310− Code derived from the document "Report on the Programming Language
311− Haskell 98", is distributed under the following license:
312−
313− Copyright (c) 2002 Simon Peyton Jones
314−
315− The authors intend this Report to belong to the entire Haskell
316− community, and so we grant permission to copy and distribute it for
317− any purpose, provided that it is reproduced in its entirety,
318− including this Notice. Modified versions of this Report may also be
319− copied and distributed for any purpose, provided that the modified
320− version is clearly presented as such, and that it does not claim to
321− be a definition of the Haskell 98 Language.
322−
323− -----------------------------------------------------------------------------
324−
325− Code derived from the document "The Haskell 98 Foreign Function
326− Interface, An Addendum to the Haskell 98 Report" is distributed under
327− the following license:
328−
329− Copyright (c) 2002 Manuel M. T. Chakravarty
330−
331− The authors intend this Report to belong to the entire Haskell
332− community, and so we grant permission to copy and distribute it for
333− any purpose, provided that it is reproduced in its entirety,
334− including this Notice. Modified versions of this Report may also be
335− copied and distributed for any purpose, provided that the modified
336− version is clearly presented as such, and that it does not claim to
337− be a definition of the Haskell 98 Foreign Function Interface.
338−
339− -----------------------------------------------------------------------------
340−
341−attoparsec LICENSE file:
342−
343− Copyright (c) Lennart Kolmodin
344−
345− All rights reserved.
346−
347− Redistribution and use in source and binary forms, with or without
348− modification, are permitted provided that the following conditions
349− are met:
350−
351− 1. Redistributions of source code must retain the above copyright
352− notice, this list of conditions and the following disclaimer.
353−
354− 2. Redistributions in binary form must reproduce the above copyright
355− notice, this list of conditions and the following disclaimer in the
356− documentation and/or other materials provided with the distribution.
357−
358− 3. Neither the name of the author nor the names of his contributors
359− may be used to endorse or promote products derived from this software
360− without specific prior written permission.
361−
362− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
363− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
364− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
365− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
366− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
367− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
368− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
369− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
370− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
371− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
372− POSSIBILITY OF SUCH DAMAGE.
373−
374−base LICENSE file:
375−
376− This library (libraries/base) is derived from code from several
377− sources:
378−
379− * Code from the GHC project which is largely (c) The University of
380− Glasgow, and distributable under a BSD-style license (see below),
381−
382− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
383− and freely redistributable (but see the full license for
384− restrictions).
385−
386− * Code from the Haskell Foreign Function Interface specification,
387− which is (c) Manuel M. T. Chakravarty and freely redistributable
388− (but see the full license for restrictions).
389−
390− The full text of these licenses is reproduced below. All of the
391− licenses are BSD-style or compatible.
392−
393− -----------------------------------------------------------------------------
394−
395− The Glasgow Haskell Compiler License
396−
397− Copyright 2004, The University Court of the University of Glasgow.
398− All rights reserved.
399−
400− Redistribution and use in source and binary forms, with or without
401− modification, are permitted provided that the following conditions are met:
402−
403− - Redistributions of source code must retain the above copyright notice,
404− this list of conditions and the following disclaimer.
405−
406− - Redistributions in binary form must reproduce the above copyright notice,
407− this list of conditions and the following disclaimer in the documentation
408− and/or other materials provided with the distribution.
409−
410− - Neither name of the University nor the names of its contributors may be
411− used to endorse or promote products derived from this software without
412− specific prior written permission.
413−
414− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
415− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
416− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
417− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
418− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
419− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
420− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
421− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
422− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
423− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
424− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
425− DAMAGE.
426−
427− -----------------------------------------------------------------------------
428−
429− Code derived from the document "Report on the Programming Language
430− Haskell 98", is distributed under the following license:
431−
432− Copyright (c) 2002 Simon Peyton Jones
433−
434− The authors intend this Report to belong to the entire Haskell
435− community, and so we grant permission to copy and distribute it for
436− any purpose, provided that it is reproduced in its entirety,
437− including this Notice. Modified versions of this Report may also be
438− copied and distributed for any purpose, provided that the modified
439− version is clearly presented as such, and that it does not claim to
440− be a definition of the Haskell 98 Language.
441−
442− -----------------------------------------------------------------------------
443−
444− Code derived from the document "The Haskell 98 Foreign Function
445− Interface, An Addendum to the Haskell 98 Report" is distributed under
446− the following license:
447−
448− Copyright (c) 2002 Manuel M. T. Chakravarty
449−
450− The authors intend this Report to belong to the entire Haskell
451− community, and so we grant permission to copy and distribute it for
452− any purpose, provided that it is reproduced in its entirety,
453− including this Notice. Modified versions of this Report may also be
454− copied and distributed for any purpose, provided that the modified
455− version is clearly presented as such, and that it does not claim to
456− be a definition of the Haskell 98 Foreign Function Interface.
457−
458− -----------------------------------------------------------------------------
459−
460−base-compat LICENSE file:
461−
462− Copyright (c) 2012-2015 Simon Hengel <sol@typeful.net> and Ryan Scott <ryan.gl.scott@ku.edu>
463−
464− Permission is hereby granted, free of charge, to any person obtaining a copy
465− of this software and associated documentation files (the "Software"), to deal
466− in the Software without restriction, including without limitation the rights
467− to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
468− copies of the Software, and to permit persons to whom the Software is
469− furnished to do so, subject to the following conditions:
470−
471− The above copyright notice and this permission notice shall be included in
472− all copies or substantial portions of the Software.
473−
474− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
475− IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
476− FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
477− AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
478− LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
479− OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
480− THE SOFTWARE.
481−
482−binary LICENSE file:
483−
484− Copyright (c) Lennart Kolmodin
485−
486− All rights reserved.
487−
488− Redistribution and use in source and binary forms, with or without
489− modification, are permitted provided that the following conditions
490− are met:
491−
492− 1. Redistributions of source code must retain the above copyright
493− notice, this list of conditions and the following disclaimer.
494−
495− 2. Redistributions in binary form must reproduce the above copyright
496− notice, this list of conditions and the following disclaimer in the
497− documentation and/or other materials provided with the distribution.
498−
499− 3. Neither the name of the author nor the names of his contributors
500− may be used to endorse or promote products derived from this software
501− without specific prior written permission.
502−
503− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
504− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
505− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
506− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
507− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
508− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
509− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
510− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
511− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
512− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
513− POSSIBILITY OF SUCH DAMAGE.
514−
515−blaze-builder LICENSE file:
516−
517− Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011
518−
519− All rights reserved.
520−
521− Redistribution and use in source and binary forms, with or without
522− modification, are permitted provided that the following conditions are met:
523−
524− * Redistributions of source code must retain the above copyright
525− notice, this list of conditions and the following disclaimer.
526−
527− * Redistributions in binary form must reproduce the above
528− copyright notice, this list of conditions and the following
529− disclaimer in the documentation and/or other materials provided
530− with the distribution.
531−
532− * Neither the name of Jasper Van der Jeugt nor the names of other
533− contributors may be used to endorse or promote products derived
534− from this software without specific prior written permission.
535−
536− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
537− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
538− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
539− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
540− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
541− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
542− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
543− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
544− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
545− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
546− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
547−
548−bower-json LICENSE file:
549−
550− Copyright (c) 2015 Harry Garrood
551−
552− Permission is hereby granted, free of charge, to any person obtaining
553− a copy of this software and associated documentation files (the
554− "Software"), to deal in the Software without restriction, including
555− without limitation the rights to use, copy, modify, merge, publish,
556− distribute, sublicense, and/or sell copies of the Software, and to
557− permit persons to whom the Software is furnished to do so, subject to
558− the following conditions:
559−
560− The above copyright notice and this permission notice shall be included
561− in all copies or substantial portions of the Software.
562−
563− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
564− EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
565− MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
566− IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
567− CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
568− TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
569− SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
570−
571−boxes LICENSE file:
572−
573− Copyright (c) Brent Yorgey 2008
574−
575− Redistribution and use in source and binary forms, with or without
576− modification, are permitted provided that the following conditions
577− are met:
578− 1. Redistributions of source code must retain the above copyright
579− notice, this list of conditions and the following disclaimer.
580− 2. Redistributions in binary form must reproduce the above copyright
581− notice, this list of conditions and the following disclaimer in the
582− documentation and/or other materials provided with the distribution.
583− 3. Neither the name of the author nor the names of other contributors
584− may be used to endorse or promote products derived from this software
585− without specific prior written permission.
586−
587− All other rights are reserved.
588−
589− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
590− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
591− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
592− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
593− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
594− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
595− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
596− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
597− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
598− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
599− SUCH DAMAGE.
600−
601−bytestring LICENSE file:
602−
603− Copyright (c) Don Stewart 2005-2009
604− (c) Duncan Coutts 2006-2015
605− (c) David Roundy 2003-2005
606− (c) Simon Meier 2010-2011
607−
608− All rights reserved.
609−
610− Redistribution and use in source and binary forms, with or without
611− modification, are permitted provided that the following conditions
612− are met:
613− 1. Redistributions of source code must retain the above copyright
614− notice, this list of conditions and the following disclaimer.
615− 2. Redistributions in binary form must reproduce the above copyright
616− notice, this list of conditions and the following disclaimer in the
617− documentation and/or other materials provided with the distribution.
618− 3. Neither the name of the author nor the names of his contributors
619− may be used to endorse or promote products derived from this software
620− without specific prior written permission.
621−
622− THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
623− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
624− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
625− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
626− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
627− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
628− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
629− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
630− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
631− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
632− SUCH DAMAGE.
633−
634−containers LICENSE file:
635−
636− The Glasgow Haskell Compiler License
637−
638− Copyright 2004, The University Court of the University of Glasgow.
639− All rights reserved.
640−
641− Redistribution and use in source and binary forms, with or without
642− modification, are permitted provided that the following conditions are met:
643−
644− - Redistributions of source code must retain the above copyright notice,
645− this list of conditions and the following disclaimer.
646−
647− - Redistributions in binary form must reproduce the above copyright notice,
648− this list of conditions and the following disclaimer in the documentation
649− and/or other materials provided with the distribution.
650−
651− - Neither name of the University nor the names of its contributors may be
652− used to endorse or promote products derived from this software without
653− specific prior written permission.
654−
655− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
656− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
657− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
658− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
659− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
660− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
661− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
662− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
663− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
664− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
665− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
666− DAMAGE.
667−
668−deepseq LICENSE file:
669−
670− This library (deepseq) is derived from code from the GHC project which
671− is largely (c) The University of Glasgow, and distributable under a
672− BSD-style license (see below).
673−
674− -----------------------------------------------------------------------------
675−
676− The Glasgow Haskell Compiler License
677−
678− Copyright 2001-2009, The University Court of the University of Glasgow.
679− All rights reserved.
680−
681− Redistribution and use in source and binary forms, with or without
682− modification, are permitted provided that the following conditions are met:
683−
684− - Redistributions of source code must retain the above copyright notice,
685− this list of conditions and the following disclaimer.
686−
687− - Redistributions in binary form must reproduce the above copyright notice,
688− this list of conditions and the following disclaimer in the documentation
689− and/or other materials provided with the distribution.
690−
691− - Neither name of the University nor the names of its contributors may be
692− used to endorse or promote products derived from this software without
693− specific prior written permission.
694−
695− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
696− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
697− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
698− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
699− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
700− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
701− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
702− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
703− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
704− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
705− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
706− DAMAGE.
707−
708− -----------------------------------------------------------------------------
709−
710−directory LICENSE file:
711−
712− This library (libraries/base) is derived from code from two
713− sources:
714−
715− * Code from the GHC project which is largely (c) The University of
716− Glasgow, and distributable under a BSD-style license (see below),
717−
718− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
719− and freely redistributable (but see the full license for
720− restrictions).
721−
722− The full text of these licenses is reproduced below. Both of the
723− licenses are BSD-style or compatible.
724−
725− -----------------------------------------------------------------------------
726−
727− The Glasgow Haskell Compiler License
728−
729− Copyright 2004, The University Court of the University of Glasgow.
730− All rights reserved.
731−
732− Redistribution and use in source and binary forms, with or without
733− modification, are permitted provided that the following conditions are met:
734−
735− - Redistributions of source code must retain the above copyright notice,
736− this list of conditions and the following disclaimer.
737−
738− - Redistributions in binary form must reproduce the above copyright notice,
739− this list of conditions and the following disclaimer in the documentation
740− and/or other materials provided with the distribution.
741−
742− - Neither name of the University nor the names of its contributors may be
743− used to endorse or promote products derived from this software without
744− specific prior written permission.
745−
746− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
747− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
748− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
749− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
750− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
751− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
752− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
753− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
754− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
755− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
756− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
757− DAMAGE.
758−
759− -----------------------------------------------------------------------------
760−
761− Code derived from the document "Report on the Programming Language
762− Haskell 98", is distributed under the following license:
763−
764− Copyright (c) 2002 Simon Peyton Jones
765−
766− The authors intend this Report to belong to the entire Haskell
767− community, and so we grant permission to copy and distribute it for
768− any purpose, provided that it is reproduced in its entirety,
769− including this Notice. Modified versions of this Report may also be
770− copied and distributed for any purpose, provided that the modified
771− version is clearly presented as such, and that it does not claim to
772− be a definition of the Haskell 98 Language.
773−
774− -----------------------------------------------------------------------------
775−
776−dlist LICENSE file:
777−
778− Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather
779−
780− All rights reserved.
781−
782− Redistribution and use in source and binary forms, with or without
783− modification, are permitted provided that the following conditions are
784− met:
785−
786− * Redistributions of source code must retain the above copyright
787− notice, this list of conditions and the following disclaimer.
788−
789− * Redistributions in binary form must reproduce the above
790− copyright notice, this list of conditions and the following
791− disclaimer in the documentation and/or other materials provided
792− with the distribution.
793−
794− * Neither the name of Don Stewart nor the names of other
795− contributors may be used to endorse or promote products derived
796− from this software without specific prior written permission.
797−
798− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
799− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
800− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
801− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
802− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
803− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
804− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
805− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
806− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
807− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
808− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
809−
810−filepath LICENSE file:
811−
812− Copyright Neil Mitchell 2005-2015.
813− All rights reserved.
814−
815− Redistribution and use in source and binary forms, with or without
816− modification, are permitted provided that the following conditions are
817− met:
818−
819− * Redistributions of source code must retain the above copyright
820− notice, this list of conditions and the following disclaimer.
821−
822− * Redistributions in binary form must reproduce the above
823− copyright notice, this list of conditions and the following
824− disclaimer in the documentation and/or other materials provided
825− with the distribution.
826−
827− * Neither the name of Neil Mitchell nor the names of other
828− contributors may be used to endorse or promote products derived
829− from this software without specific prior written permission.
830−
831− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
832− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
833− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
834− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
835− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
836− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
837− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
838− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
839− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
840− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
841− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
842−
843−ghc-prim LICENSE file:
844−
845− This library (libraries/ghc-prim) is derived from code from several
846− sources:
847−
848− * Code from the GHC project which is largely (c) The University of
849− Glasgow, and distributable under a BSD-style license (see below),
850−
851− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
852− and freely redistributable (but see the full license for
853− restrictions).
854−
855− The full text of these licenses is reproduced below. All of the
856− licenses are BSD-style or compatible.
857−
858− -----------------------------------------------------------------------------
859−
860− The Glasgow Haskell Compiler License
861−
862− Copyright 2004, The University Court of the University of Glasgow.
863− All rights reserved.
864−
865− Redistribution and use in source and binary forms, with or without
866− modification, are permitted provided that the following conditions are met:
867−
868− - Redistributions of source code must retain the above copyright notice,
869− this list of conditions and the following disclaimer.
870−
871− - Redistributions in binary form must reproduce the above copyright notice,
872− this list of conditions and the following disclaimer in the documentation
873− and/or other materials provided with the distribution.
874−
875− - Neither name of the University nor the names of its contributors may be
876− used to endorse or promote products derived from this software without
877− specific prior written permission.
878−
879− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
880− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
881− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
882− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
883− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
884− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
885− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
886− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
887− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
888− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
889− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
890− DAMAGE.
891−
892− -----------------------------------------------------------------------------
893−
894− Code derived from the document "Report on the Programming Language
895− Haskell 98", is distributed under the following license:
896−
897− Copyright (c) 2002 Simon Peyton Jones
898−
899− The authors intend this Report to belong to the entire Haskell
900− community, and so we grant permission to copy and distribute it for
901− any purpose, provided that it is reproduced in its entirety,
902− including this Notice. Modified versions of this Report may also be
903− copied and distributed for any purpose, provided that the modified
904− version is clearly presented as such, and that it does not claim to
905− be a definition of the Haskell 98 Language.
906−
907−
908−hashable LICENSE file:
909−
910− Copyright Milan Straka 2010
911−
912− All rights reserved.
913−
914− Redistribution and use in source and binary forms, with or without
915− modification, are permitted provided that the following conditions are met:
916−
917− * Redistributions of source code must retain the above copyright
918− notice, this list of conditions and the following disclaimer.
919−
920− * Redistributions in binary form must reproduce the above
921− copyright notice, this list of conditions and the following
922− disclaimer in the documentation and/or other materials provided
923− with the distribution.
924−
925− * Neither the name of Milan Straka nor the names of other
926− contributors may be used to endorse or promote products derived
927− from this software without specific prior written permission.
928−
929− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
930− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
931− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
932− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
933− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
934− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
935− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
936− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
937− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
938− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
939− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
940−
941−haskeline LICENSE file:
942−
943− Copyright 2007-2009, Judah Jacobson.
944− All Rights Reserved.
945−
946− Redistribution and use in source and binary forms, with or without
947− modification, are permitted provided that the following conditions are met:
948−
949− - Redistribution of source code must retain the above copyright notice,
950− this list of conditions and the following disclaimer.
951−
952− - Redistribution in binary form must reproduce the above copyright notice,
953− this list of conditions and the following disclaimer in the documentation
954− and/or other materials provided with the distribution.
955−
956− THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
957− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
958− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
959− DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
960− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
961− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
962− SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
963− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
964− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
965− USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
966−
967−integer-gmp LICENSE file:
968−
969− Copyright (c) 2014, Herbert Valerio Riedel
970−
971− All rights reserved.
972−
973− Redistribution and use in source and binary forms, with or without
974− modification, are permitted provided that the following conditions are met:
975−
976− * Redistributions of source code must retain the above copyright
977− notice, this list of conditions and the following disclaimer.
978−
979− * Redistributions in binary form must reproduce the above
980− copyright notice, this list of conditions and the following
981− disclaimer in the documentation and/or other materials provided
982− with the distribution.
983−
984− * Neither the name of Herbert Valerio Riedel nor the names of other
985− contributors may be used to endorse or promote products derived
986− from this software without specific prior written permission.
987−
988− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
989− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
990− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
991− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
992− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
993− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
994− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
995− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
996− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
997− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
998− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
999−
1000−language-javascript LICENSE file:
1001−
1002− Copyright (c)2010, Alan Zimmerman
1003−
1004− All rights reserved.
1005−
1006− Redistribution and use in source and binary forms, with or without
1007− modification, are permitted provided that the following conditions are met:
1008−
1009− * Redistributions of source code must retain the above copyright
1010− notice, this list of conditions and the following disclaimer.
1011−
1012− * Redistributions in binary form must reproduce the above
1013− copyright notice, this list of conditions and the following
1014− disclaimer in the documentation and/or other materials provided
1015− with the distribution.
1016−
1017− * Neither the name of Alan Zimmerman nor the names of other
1018− contributors may be used to endorse or promote products derived
1019− from this software without specific prior written permission.
1020−
1021− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1022− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1023− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1024− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1025− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1026− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1027− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1028− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1029− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1030− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1031− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1032−
1033−lifted-base LICENSE file:
1034−
1035− Copyright © 2010-2012, Bas van Dijk, Anders Kaseorg
1036− All rights reserved.
1037−
1038− Redistribution and use in source and binary forms, with or without
1039− modification, are permitted provided that the following conditions are
1040− met:
1041−
1042− • Redistributions of source code must retain the above copyright
1043− notice, this list of conditions and the following disclaimer.
1044−
1045− • Redistributions in binary form must reproduce the above copyright
1046− notice, this list of conditions and the following disclaimer in the
1047− documentation and/or other materials provided with the distribution.
1048−
1049− • Neither the name of the author nor the names of other contributors
1050− may be used to endorse or promote products derived from this
1051− software without specific prior written permission.
1052−
1053− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1054− “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1055− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1056− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1057− HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1058− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1059− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1060− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1061− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1062− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1063− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1064−
1065−monad-control LICENSE file:
1066−
1067− Copyright © 2010, Bas van Dijk, Anders Kaseorg
1068− All rights reserved.
1069−
1070− Redistribution and use in source and binary forms, with or without
1071− modification, are permitted provided that the following conditions are
1072− met:
1073−
1074− • Redistributions of source code must retain the above copyright
1075− notice, this list of conditions and the following disclaimer.
1076−
1077− • Redistributions in binary form must reproduce the above copyright
1078− notice, this list of conditions and the following disclaimer in the
1079− documentation and/or other materials provided with the distribution.
1080−
1081− • Neither the name of the author nor the names of other contributors
1082− may be used to endorse or promote products derived from this
1083− software without specific prior written permission.
1084−
1085− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1086− “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1087− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1088− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1089− HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1090− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1091− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1092− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1093− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1094− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1095− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1096−
1097−mtl LICENSE file:
1098−
1099− The Glasgow Haskell Compiler License
1100−
1101− Copyright 2004, The University Court of the University of Glasgow.
1102− All rights reserved.
1103−
1104− Redistribution and use in source and binary forms, with or without
1105− modification, are permitted provided that the following conditions are met:
1106−
1107− - Redistributions of source code must retain the above copyright notice,
1108− this list of conditions and the following disclaimer.
1109−
1110− - Redistributions in binary form must reproduce the above copyright notice,
1111− this list of conditions and the following disclaimer in the documentation
1112− and/or other materials provided with the distribution.
1113−
1114− - Neither name of the University nor the names of its contributors may be
1115− used to endorse or promote products derived from this software without
1116− specific prior written permission.
1117−
1118− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1119− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1120− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1121− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1122− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1123− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1124− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1125− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1126− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1127− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1128− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1129− DAMAGE.
1130−
1131−nats LICENSE file:
1132−
1133− Copyright 2011-2014 Edward Kmett
1134−
1135− All rights reserved.
1136−
1137− Redistribution and use in source and binary forms, with or without
1138− modification, are permitted provided that the following conditions
1139− are met:
1140−
1141− 1. Redistributions of source code must retain the above copyright
1142− notice, this list of conditions and the following disclaimer.
1143−
1144− 2. Redistributions in binary form must reproduce the above copyright
1145− notice, this list of conditions and the following disclaimer in the
1146− documentation and/or other materials provided with the distribution.
1147−
1148− 3. Neither the name of the author nor the names of his contributors
1149− may be used to endorse or promote products derived from this software
1150− without specific prior written permission.
1151−
1152− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1153− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1154− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1155− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1156− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1157− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1158− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1159− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1160− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1161− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1162− POSSIBILITY OF SUCH DAMAGE.
1163−
1164−old-locale LICENSE file:
1165−
1166− This library (libraries/base) is derived from code from two
1167− sources:
1168−
1169− * Code from the GHC project which is largely (c) The University of
1170− Glasgow, and distributable under a BSD-style license (see below),
1171−
1172− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1173− and freely redistributable (but see the full license for
1174− restrictions).
1175−
1176− The full text of these licenses is reproduced below. Both of the
1177− licenses are BSD-style or compatible.
1178−
1179− -----------------------------------------------------------------------------
1180−
1181− The Glasgow Haskell Compiler License
1182−
1183− Copyright 2004, The University Court of the University of Glasgow.
1184− All rights reserved.
1185−
1186− Redistribution and use in source and binary forms, with or without
1187− modification, are permitted provided that the following conditions are met:
1188−
1189− - Redistributions of source code must retain the above copyright notice,
1190− this list of conditions and the following disclaimer.
1191−
1192− - Redistributions in binary form must reproduce the above copyright notice,
1193− this list of conditions and the following disclaimer in the documentation
1194− and/or other materials provided with the distribution.
1195−
1196− - Neither name of the University nor the names of its contributors may be
1197− used to endorse or promote products derived from this software without
1198− specific prior written permission.
1199−
1200− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1201− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1202− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1203− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1204− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1205− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1206− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1207− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1208− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1209− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1210− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1211− DAMAGE.
1212−
1213− -----------------------------------------------------------------------------
1214−
1215− Code derived from the document "Report on the Programming Language
1216− Haskell 98", is distributed under the following license:
1217−
1218− Copyright (c) 2002 Simon Peyton Jones
1219−
1220− The authors intend this Report to belong to the entire Haskell
1221− community, and so we grant permission to copy and distribute it for
1222− any purpose, provided that it is reproduced in its entirety,
1223− including this Notice. Modified versions of this Report may also be
1224− copied and distributed for any purpose, provided that the modified
1225− version is clearly presented as such, and that it does not claim to
1226− be a definition of the Haskell 98 Language.
1227−
1228− -----------------------------------------------------------------------------
1229−
1230−optparse-applicative LICENSE file:
1231−
1232− Copyright (c) 2012, Paolo Capriotti
1233−
1234− All rights reserved.
1235−
1236− Redistribution and use in source and binary forms, with or without
1237− modification, are permitted provided that the following conditions are met:
1238−
1239− * Redistributions of source code must retain the above copyright
1240− notice, this list of conditions and the following disclaimer.
1241−
1242− * Redistributions in binary form must reproduce the above
1243− copyright notice, this list of conditions and the following
1244− disclaimer in the documentation and/or other materials provided
1245− with the distribution.
1246−
1247− * Neither the name of Paolo Capriotti nor the names of other
1248− contributors may be used to endorse or promote products derived
1249− from this software without specific prior written permission.
1250−
1251− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1252− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1253− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1254− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1255− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1256− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1257− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1258− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1259− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1260− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1261− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1262−
1263−parallel LICENSE file:
1264−
1265− This library (libraries/parallel) is derived from code from
1266− the GHC project which is largely (c) The University of
1267− Glasgow, and distributable under a BSD-style license (see below).
1268−
1269− -----------------------------------------------------------------------------
1270−
1271− The Glasgow Haskell Compiler License
1272−
1273− Copyright 2004, The University Court of the University of Glasgow.
1274− All rights reserved.
1275−
1276− Redistribution and use in source and binary forms, with or without
1277− modification, are permitted provided that the following conditions are met:
1278−
1279− - Redistributions of source code must retain the above copyright notice,
1280− this list of conditions and the following disclaimer.
1281−
1282− - Redistributions in binary form must reproduce the above copyright notice,
1283− this list of conditions and the following disclaimer in the documentation
1284− and/or other materials provided with the distribution.
1285−
1286− - Neither name of the University nor the names of its contributors may be
1287− used to endorse or promote products derived from this software without
1288− specific prior written permission.
1289−
1290− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1291− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1292− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1293− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1294− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1295− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1296− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1297− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1298− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1299− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1300− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1301− DAMAGE.
1302−
1303− -----------------------------------------------------------------------------
1304−
1305−parsec LICENSE file:
1306−
1307− Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.
1308−
1309− Redistribution and use in source and binary forms, with or without
1310− modification, are permitted provided that the following conditions are met:
1311−
1312− * Redistributions of source code must retain the above copyright notice,
1313− this list of conditions and the following disclaimer.
1314− * Redistributions in binary form must reproduce the above copyright
1315− notice, this list of conditions and the following disclaimer in the
1316− documentation and/or other materials provided with the distribution.
1317−
1318− This software is provided by the copyright holders "as is" and any express or
1319− implied warranties, including, but not limited to, the implied warranties of
1320− merchantability and fitness for a particular purpose are disclaimed. In no
1321− event shall the copyright holders be liable for any direct, indirect,
1322− incidental, special, exemplary, or consequential damages (including, but not
1323− limited to, procurement of substitute goods or services; loss of use, data,
1324− or profits; or business interruption) however caused and on any theory of
1325− liability, whether in contract, strict liability, or tort (including
1326− negligence or otherwise) arising in any way out of the use of this software,
1327− even if advised of the possibility of such damage.
1328−
1329−pattern-arrows LICENSE file:
1330−
1331− The MIT License (MIT)
1332−
1333− Copyright (c) 2013 Phil Freeman
1334−
1335− Permission is hereby granted, free of charge, to any person obtaining a copy of
1336− this software and associated documentation files (the "Software"), to deal in
1337− the Software without restriction, including without limitation the rights to
1338− use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
1339− the Software, and to permit persons to whom the Software is furnished to do so,
1340− subject to the following conditions:
1341−
1342− The above copyright notice and this permission notice shall be included in all
1343− copies or substantial portions of the Software.
1344−
1345− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
1346− IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
1347− FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
1348− COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
1349− IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
1350− CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
1351−
1352−pretty LICENSE file:
1353−
1354− This library (libraries/pretty) is derived from code from
1355− the GHC project which is largely (c) The University of
1356− Glasgow, and distributable under a BSD-style license (see below).
1357−
1358− -----------------------------------------------------------------------------
1359−
1360− The Glasgow Haskell Compiler License
1361−
1362− Copyright 2004, The University Court of the University of Glasgow.
1363− All rights reserved.
1364−
1365− Redistribution and use in source and binary forms, with or without
1366− modification, are permitted provided that the following conditions are met:
1367−
1368− - Redistributions of source code must retain the above copyright notice,
1369− this list of conditions and the following disclaimer.
1370−
1371− - Redistributions in binary form must reproduce the above copyright notice,
1372− this list of conditions and the following disclaimer in the documentation
1373− and/or other materials provided with the distribution.
1374−
1375− - Neither name of the University nor the names of its contributors may be
1376− used to endorse or promote products derived from this software without
1377− specific prior written permission.
1378−
1379− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1380− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1381− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1382− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1383− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1384− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1385− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1386− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1387− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1388− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1389− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1390− DAMAGE.
1391−
1392− -----------------------------------------------------------------------------
1393−
1394−primitive LICENSE file:
1395−
1396− Copyright (c) 2008-2009, Roman Leshchinskiy
1397− All rights reserved.
1398−
1399− Redistribution and use in source and binary forms, with or without
1400− modification, are permitted provided that the following conditions are met:
1401−
1402− - Redistributions of source code must retain the above copyright notice,
1403− this list of conditions and the following disclaimer.
1404−
1405− - Redistributions in binary form must reproduce the above copyright notice,
1406− this list of conditions and the following disclaimer in the documentation
1407− and/or other materials provided with the distribution.
1408−
1409− - Neither name of the University nor the names of its contributors may be
1410− used to endorse or promote products derived from this software without
1411− specific prior written permission.
1412−
1413− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1414− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1415− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1416− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1417− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1418− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1419− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1420− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1421− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1422− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1423− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1424− DAMAGE.
1425−
1426−
1427−process LICENSE file:
1428−
1429− This library (libraries/process) is derived from code from two
1430− sources:
1431−
1432− * Code from the GHC project which is largely (c) The University of
1433− Glasgow, and distributable under a BSD-style license (see below),
1434−
1435− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1436− and freely redistributable (but see the full license for
1437− restrictions).
1438−
1439− The full text of these licenses is reproduced below. Both of the
1440− licenses are BSD-style or compatible.
1441−
1442− -----------------------------------------------------------------------------
1443−
1444− The Glasgow Haskell Compiler License
1445−
1446− Copyright 2004, The University Court of the University of Glasgow.
1447− All rights reserved.
1448−
1449− Redistribution and use in source and binary forms, with or without
1450− modification, are permitted provided that the following conditions are met:
1451−
1452− - Redistributions of source code must retain the above copyright notice,
1453− this list of conditions and the following disclaimer.
1454−
1455− - Redistributions in binary form must reproduce the above copyright notice,
1456− this list of conditions and the following disclaimer in the documentation
1457− and/or other materials provided with the distribution.
1458−
1459− - Neither name of the University nor the names of its contributors may be
1460− used to endorse or promote products derived from this software without
1461− specific prior written permission.
1462−
1463− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1464− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1465− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1466− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1467− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1468− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1469− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1470− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1471− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1472− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1473− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1474− DAMAGE.
1475−
1476− -----------------------------------------------------------------------------
1477−
1478− Code derived from the document "Report on the Programming Language
1479− Haskell 98", is distributed under the following license:
1480−
1481− Copyright (c) 2002 Simon Peyton Jones
1482−
1483− The authors intend this Report to belong to the entire Haskell
1484− community, and so we grant permission to copy and distribute it for
1485− any purpose, provided that it is reproduced in its entirety,
1486− including this Notice. Modified versions of this Report may also be
1487− copied and distributed for any purpose, provided that the modified
1488− version is clearly presented as such, and that it does not claim to
1489− be a definition of the Haskell 98 Language.
1490−
1491− -----------------------------------------------------------------------------
1492−
1493−rts LICENSE file:
1494−
1495− Package not found: No such package in package index
1496−
1497−safe LICENSE file:
1498−
1499− Copyright Neil Mitchell 2007-2015.
1500− All rights reserved.
1501−
1502− Redistribution and use in source and binary forms, with or without
1503− modification, are permitted provided that the following conditions are
1504− met:
1505−
1506− * Redistributions of source code must retain the above copyright
1507− notice, this list of conditions and the following disclaimer.
1508−
1509− * Redistributions in binary form must reproduce the above
1510− copyright notice, this list of conditions and the following
1511− disclaimer in the documentation and/or other materials provided
1512− with the distribution.
1513−
1514− * Neither the name of Neil Mitchell nor the names of other
1515− contributors may be used to endorse or promote products derived
1516− from this software without specific prior written permission.
1517−
1518− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1519− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1520− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1521− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1522− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1523− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1524− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1525− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1526− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1527− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1528− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1529−
1530−scientific LICENSE file:
1531−
1532− Copyright (c) 2013, Bas van Dijk
1533−
1534− All rights reserved.
1535−
1536− Redistribution and use in source and binary forms, with or without
1537− modification, are permitted provided that the following conditions are met:
1538−
1539− * Redistributions of source code must retain the above copyright
1540− notice, this list of conditions and the following disclaimer.
1541−
1542− * Redistributions in binary form must reproduce the above
1543− copyright notice, this list of conditions and the following
1544− disclaimer in the documentation and/or other materials provided
1545− with the distribution.
1546−
1547− * Neither the name of Bas van Dijk nor the names of other
1548− contributors may be used to endorse or promote products derived
1549− from this software without specific prior written permission.
1550−
1551− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1552− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1553− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1554− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1555− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1556− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1557− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1558− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1559− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1560− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1561− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1562−
1563−semigroups LICENSE file:
1564−
1565− Copyright 2011-2015 Edward Kmett
1566−
1567− All rights reserved.
1568−
1569− Redistribution and use in source and binary forms, with or without
1570− modification, are permitted provided that the following conditions
1571− are met:
1572−
1573− 1. Redistributions of source code must retain the above copyright
1574− notice, this list of conditions and the following disclaimer.
1575−
1576− 2. Redistributions in binary form must reproduce the above copyright
1577− notice, this list of conditions and the following disclaimer in the
1578− documentation and/or other materials provided with the distribution.
1579−
1580− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1581− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1582− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1583− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1584− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1585− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1586− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1587− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1588− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1589− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1590− POSSIBILITY OF SUCH DAMAGE.
1591−
1592−split LICENSE file:
1593−
1594− Copyright (c) 2008 Brent Yorgey, Louis Wasserman
1595−
1596− All rights reserved.
1597−
1598− Redistribution and use in source and binary forms, with or without
1599− modification, are permitted provided that the following conditions
1600− are met:
1601− 1. Redistributions of source code must retain the above copyright
1602− notice, this list of conditions and the following disclaimer.
1603− 2. Redistributions in binary form must reproduce the above copyright
1604− notice, this list of conditions and the following disclaimer in the
1605− documentation and/or other materials provided with the distribution.
1606− 3. Neither the name of the author nor the names of other contributors
1607− may be used to endorse or promote products derived from this software
1608− without specific prior written permission.
1609−
1610− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
1611− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
1612− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
1613− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
1614− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1615− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1616− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1617− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1618− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1619− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1620− SUCH DAMAGE.
1621−
1622−stm LICENSE file:
1623−
1624− The Glasgow Haskell Compiler License
1625−
1626− Copyright 2004, The University Court of the University of Glasgow.
1627− All rights reserved.
1628−
1629− Redistribution and use in source and binary forms, with or without
1630− modification, are permitted provided that the following conditions are met:
1631−
1632− - Redistributions of source code must retain the above copyright notice,
1633− this list of conditions and the following disclaimer.
1634−
1635− - Redistributions in binary form must reproduce the above copyright notice,
1636− this list of conditions and the following disclaimer in the documentation
1637− and/or other materials provided with the distribution.
1638−
1639− - Neither name of the University nor the names of its contributors may be
1640− used to endorse or promote products derived from this software without
1641− specific prior written permission.
1642−
1643− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1644− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1645− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1646− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1647− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1648− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1649− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1650− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1651− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1652− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1653− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1654− DAMAGE.
1655−
1656−syb LICENSE file:
1657−
1658− This library (libraries/syb) is derived from code from several
1659− sources:
1660−
1661− * Code from the GHC project which is largely (c) The University of
1662− Glasgow, and distributable under a BSD-style license (see below),
1663−
1664− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1665− and freely redistributable (but see the full license for
1666− restrictions).
1667−
1668− * Code from the Haskell Foreign Function Interface specification,
1669− which is (c) Manuel M. T. Chakravarty and freely redistributable
1670− (but see the full license for restrictions).
1671−
1672− The full text of these licenses is reproduced below. All of the
1673− licenses are BSD-style or compatible.
1674−
1675− -----------------------------------------------------------------------------
1676−
1677− The Glasgow Haskell Compiler License
1678−
1679− Copyright 2004, The University Court of the University of Glasgow.
1680− All rights reserved.
1681−
1682− Redistribution and use in source and binary forms, with or without
1683− modification, are permitted provided that the following conditions are met:
1684−
1685− - Redistributions of source code must retain the above copyright notice,
1686− this list of conditions and the following disclaimer.
1687−
1688− - Redistributions in binary form must reproduce the above copyright notice,
1689− this list of conditions and the following disclaimer in the documentation
1690− and/or other materials provided with the distribution.
1691−
1692− - Neither name of the University nor the names of its contributors may be
1693− used to endorse or promote products derived from this software without
1694− specific prior written permission.
1695−
1696− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1697− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1698− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1699− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1700− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1701− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1702− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1703− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1704− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1705− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1706− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1707− DAMAGE.
1708−
1709− -----------------------------------------------------------------------------
1710−
1711− Code derived from the document "Report on the Programming Language
1712− Haskell 98", is distributed under the following license:
1713−
1714− Copyright (c) 2002 Simon Peyton Jones
1715−
1716− The authors intend this Report to belong to the entire Haskell
1717− community, and so we grant permission to copy and distribute it for
1718− any purpose, provided that it is reproduced in its entirety,
1719− including this Notice. Modified versions of this Report may also be
1720− copied and distributed for any purpose, provided that the modified
1721− version is clearly presented as such, and that it does not claim to
1722− be a definition of the Haskell 98 Language.
1723−
1724− -----------------------------------------------------------------------------
1725−
1726− Code derived from the document "The Haskell 98 Foreign Function
1727− Interface, An Addendum to the Haskell 98 Report" is distributed under
1728− the following license:
1729−
1730− Copyright (c) 2002 Manuel M. T. Chakravarty
1731−
1732− The authors intend this Report to belong to the entire Haskell
1733− community, and so we grant permission to copy and distribute it for
1734− any purpose, provided that it is reproduced in its entirety,
1735− including this Notice. Modified versions of this Report may also be
1736− copied and distributed for any purpose, provided that the modified
1737− version is clearly presented as such, and that it does not claim to
1738− be a definition of the Haskell 98 Foreign Function Interface.
1739−
1740− -----------------------------------------------------------------------------
1741−
1742−tagged LICENSE file:
1743−
1744− Copyright (c) 2009-2015 Edward Kmett
1745− All rights reserved.
1746−
1747− Redistribution and use in source and binary forms, with or without
1748− modification, are permitted provided that the following conditions are
1749− met:
1750−
1751− * Redistributions of source code must retain the above copyright
1752− notice, this list of conditions and the following disclaimer.
1753−
1754− * Redistributions in binary form must reproduce the above
1755− copyright notice, this list of conditions and the following
1756− disclaimer in the documentation and/or other materials provided
1757− with the distribution.
1758−
1759− * Neither the name of Edward Kmett nor the names of other
1760− contributors may be used to endorse or promote products derived
1761− from this software without specific prior written permission.
1762−
1763− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1764− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1765− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1766− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1767− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1768− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1769− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1770− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1771− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1772− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1773− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1774−
1775−template-haskell LICENSE file:
1776−
1777−
1778− The Glasgow Haskell Compiler License
1779−
1780− Copyright 2002-2007, The University Court of the University of Glasgow.
1781− All rights reserved.
1782−
1783− Redistribution and use in source and binary forms, with or without
1784− modification, are permitted provided that the following conditions are met:
1785−
1786− - Redistributions of source code must retain the above copyright notice,
1787− this list of conditions and the following disclaimer.
1788−
1789− - Redistributions in binary form must reproduce the above copyright notice,
1790− this list of conditions and the following disclaimer in the documentation
1791− and/or other materials provided with the distribution.
1792−
1793− - Neither name of the University nor the names of its contributors may be
1794− used to endorse or promote products derived from this software without
1795− specific prior written permission.
1796−
1797− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1798− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1799− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1800− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1801− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1802− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1803− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1804− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1805− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1806− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1807− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1808− DAMAGE.
1809−
1810−
1811−terminfo LICENSE file:
1812−
1813− Copyright 2007, Judah Jacobson.
1814− All Rights Reserved.
1815−
1816− Redistribution and use in source and binary forms, with or without
1817− modification, are permitted provided that the following conditions are met:
1818−
1819− - Redistribution of source code must retain the above copyright notice,
1820− this list of conditions and the following disclamer.
1821−
1822− - Redistribution in binary form must reproduce the above copyright notice,
1823− this list of conditions and the following disclamer in the documentation
1824− and/or other materials provided with the distribution.
1825−
1826− THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
1827− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1828− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1829− DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
1830− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1831− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1832− SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1833− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1834− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
1835− USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1836−
1837−text LICENSE file:
1838−
1839− Copyright (c) 2008-2009, Tom Harper
1840− All rights reserved.
1841−
1842− Redistribution and use in source and binary forms, with or without
1843− modification, are permitted provided that the following conditions
1844− are met:
1845−
1846− * Redistributions of source code must retain the above copyright
1847− notice, this list of conditions and the following disclaimer.
1848−
1849− * Redistributions in binary form must reproduce the above
1850− copyright notice, this list of conditions and the following
1851− disclaimer in the documentation and/or other materials provided
1852− with the distribution.
1853−
1854− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1855− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1856− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1857− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1858− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1859− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1860− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1861− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1862− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1863− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1864− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1865−
1866−time LICENSE file:
1867−
1868− TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.
1869− Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.
1870−
1871− Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
1872−
1873− - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
1874−
1875− - 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.
1876−
1877− 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.
1878−
1879−transformers LICENSE file:
1880−
1881− The Glasgow Haskell Compiler License
1882−
1883− Copyright 2004, The University Court of the University of Glasgow.
1884− All rights reserved.
1885−
1886− Redistribution and use in source and binary forms, with or without
1887− modification, are permitted provided that the following conditions are met:
1888−
1889− - Redistributions of source code must retain the above copyright notice,
1890− this list of conditions and the following disclaimer.
1891−
1892− - Redistributions in binary form must reproduce the above copyright notice,
1893− this list of conditions and the following disclaimer in the documentation
1894− and/or other materials provided with the distribution.
1895−
1896− - Neither name of the University nor the names of its contributors may be
1897− used to endorse or promote products derived from this software without
1898− specific prior written permission.
1899−
1900− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1901− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1902− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1903− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1904− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1905− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1906− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1907− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1908− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1909− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1910− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1911− DAMAGE.
1912−
1913−transformers-base LICENSE file:
1914−
1915− Copyright (c) 2011, Mikhail Vorozhtsov, Bas van Dijk
1916− All rights reserved.
1917−
1918− Redistribution and use in source and binary forms, with or without
1919− modification, are permitted provided that the following conditions are met:
1920−
1921− - Redistributions of source code must retain the above copyright notice,
1922− this list of conditions and the following disclaimer.
1923− - Redistributions in binary form must reproduce the above copyright
1924− notice, this list of conditions and the following disclaimer in the
1925− documentation and/or other materials provided with the distribution.
1926− - Neither the names of the copyright owners nor the names of the
1927− contributors may be used to endorse or promote products derived
1928− from this software without specific prior written permission.
1929−
1930− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1931− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1932− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1933− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1934− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1935− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1936− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1937− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1938− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1939− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1940− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1941−
1942−
1943−transformers-compat LICENSE file:
1944−
1945− Copyright 2012 Edward Kmett
1946−
1947− All rights reserved.
1948−
1949− Redistribution and use in source and binary forms, with or without
1950− modification, are permitted provided that the following conditions
1951− are met:
1952−
1953− 1. Redistributions of source code must retain the above copyright
1954− notice, this list of conditions and the following disclaimer.
1955−
1956− 2. Redistributions in binary form must reproduce the above copyright
1957− notice, this list of conditions and the following disclaimer in the
1958− documentation and/or other materials provided with the distribution.
1959−
1960− 3. Neither the name of the author nor the names of his contributors
1961− may be used to endorse or promote products derived from this software
1962− without specific prior written permission.
1963−
1964− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1965− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1966− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1967− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1968− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1969− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1970− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1971− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1972− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1973− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1974− POSSIBILITY OF SUCH DAMAGE.
1975−
1976−unix LICENSE file:
1977−
1978− The Glasgow Haskell Compiler License
1979−
1980− Copyright 2004, The University Court of the University of Glasgow.
1981− All rights reserved.
1982−
1983− Redistribution and use in source and binary forms, with or without
1984− modification, are permitted provided that the following conditions are met:
1985−
1986− - Redistributions of source code must retain the above copyright notice,
1987− this list of conditions and the following disclaimer.
1988−
1989− - Redistributions in binary form must reproduce the above copyright notice,
1990− this list of conditions and the following disclaimer in the documentation
1991− and/or other materials provided with the distribution.
1992−
1993− - Neither name of the University nor the names of its contributors may be
1994− used to endorse or promote products derived from this software without
1995− specific prior written permission.
1996−
1997− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1998− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1999− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
2000− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
2001− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
2002− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
2003− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
2004− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
2005− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
2006− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
2007− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
2008− DAMAGE.
2009−
2010−unordered-containers LICENSE file:
2011−
2012− Copyright (c) 2010, Johan Tibell
2013−
2014− All rights reserved.
2015−
2016− Redistribution and use in source and binary forms, with or without
2017− modification, are permitted provided that the following conditions are met:
2018−
2019− * Redistributions of source code must retain the above copyright
2020− notice, this list of conditions and the following disclaimer.
2021−
2022− * Redistributions in binary form must reproduce the above
2023− copyright notice, this list of conditions and the following
2024− disclaimer in the documentation and/or other materials provided
2025− with the distribution.
2026−
2027− * Neither the name of Johan Tibell nor the names of other
2028− contributors may be used to endorse or promote products derived
2029− from this software without specific prior written permission.
2030−
2031− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
2032− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
2033− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
2034− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
2035− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
2036− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
2037− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
2038− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
2039− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
2040− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2041− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2042−
2043−utf8-string LICENSE file:
2044−
2045− * Copyright (c) 2007, Galois Inc.
2046− * All rights reserved.
2047− *
2048− * Redistribution and use in source and binary forms, with or without
2049− * modification, are permitted provided that the following conditions are met:
2050− * * Redistributions of source code must retain the above copyright
2051− * notice, this list of conditions and the following disclaimer.
2052− * * Redistributions in binary form must reproduce the above copyright
2053− * notice, this list of conditions and the following disclaimer in the
2054− * documentation and/or other materials provided with the distribution.
2055− * * Neither the name of Galois Inc. nor the
2056− * names of its contributors may be used to endorse or promote products
2057− * derived from this software without specific prior written permission.
2058− *
2059− * THIS SOFTWARE IS PROVIDED BY Galois Inc. ``AS IS'' AND ANY
2060− * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
2061− * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
2062− * DISCLAIMED. IN NO EVENT SHALL Galois Inc. BE LIABLE FOR ANY
2063− * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
2064− * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
2065− * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
2066− * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
2067− * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
2068− * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
2069−
2070−vector LICENSE file:
2071−
2072− Copyright (c) 2008-2012, Roman Leshchinskiy
2073− All rights reserved.
2074−
2075− Redistribution and use in source and binary forms, with or without
2076− modification, are permitted provided that the following conditions are met:
2077−
2078− - Redistributions of source code must retain the above copyright notice,
2079− this list of conditions and the following disclaimer.
2080−
2081− - Redistributions in binary form must reproduce the above copyright notice,
2082− this list of conditions and the following disclaimer in the documentation
2083− and/or other materials provided with the distribution.
2084−
2085− - Neither name of the University nor the names of its contributors may be
2086− used to endorse or promote products derived from this software without
2087− specific prior written permission.
2088−
2089− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
2090− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
2091− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
2092− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
2093− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
2094− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
2095− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
2096− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
2097− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
2098− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
2099− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
2100− DAMAGE.
2101−
2102−
2103−void LICENSE file:
2104−
2105− Copyright 2015 Edward Kmett
2106−
2107− All rights reserved.
2108−
2109− Redistribution and use in source and binary forms, with or without
2110− modification, are permitted provided that the following conditions
2111− are met:
2112−
2113− 1. Redistributions of source code must retain the above copyright
2114− notice, this list of conditions and the following disclaimer.
2115−
2116− 2. Redistributions in binary form must reproduce the above copyright
2117− notice, this list of conditions and the following disclaimer in the
2118− documentation and/or other materials provided with the distribution.
2119−
2120− 3. Neither the name of the author nor the names of his contributors
2121− may be used to endorse or promote products derived from this software
2122− without specific prior written permission.
2123−
2124− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
2125− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
2126− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
2127− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
2128− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
2129− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
2130− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
2131− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
2132− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
2133− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
2134− POSSIBILITY OF SUCH DAMAGE.
2135−
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+32−20
@@ -1,29 +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://img.shields.io/hackage/v/purescript.svg)](http://hackage.haskell.org/package/purescript) [![Build Status](https://api.travis-ci.org/purescript/purescript.svg?branch=master)](http://travis-ci.org/purescript/purescript)
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−[![Stackage LTS 2](http://stackage.org/package/purescript/badge/lts-2)](http://stackage.org/lts-2/package/purescript)
8−[![Stackage LTS 3](http://stackage.org/package/purescript/badge/lts-3)](http://stackage.org/lts-3/package/purescript)
9−[![Stackage Nightly](http://stackage.org/package/purescript/badge/nightly)](http://stackage.org/nightly/package/purescript)
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`
1020
11−## Language info
1221
13−- [PureScript home](http://purescript.org)
14−- [Releases & changelog](https://github.com/purescript/purescript/releases)
15−- [Contributing to PureScript](https://github.com/purescript/purescript/blob/master/CONTRIBUTING.md)
22+#### Requirements for building `pscpp` and `psgo`
1623
17−## Resources
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/))
1825
19−- [PureScript book](https://leanpub.com/purescript/read)
20−- [Wiki](http://wiki.purescript.org)
21−- [Try PureScript](http://try.purescript.org)
22−- [Pursuit Package Index](http://pursuit.purescript.org/)
26+#### Requirements for using PureScript + purescript-native
2327
24−## Help!
28+* A recent version (0.13+) of [purescript](https://github.com/purescript/purescript/releases).
2529
26−- [#purescript IRC @ FreeNode](http://webchat.freenode.net/?channels=purescript)
27−- [PureScript on StackOverflow](http://stackoverflow.com/questions/tagged/purescript)
28−- [Google Group](https://groups.google.com/forum/#!forum/purescript)
29−- [Gitter Channel](https://gitter.im/purescript/purescript?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
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−4
@@ -1,4 +0,0 @@
1−build/
2−*.tar.gz
3−*.sha
4−*.md5
bundle/READMEdeleted−21
@@ -1,21 +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
14−- psci The PureScript interactive REPL (requires NodeJS)
15−- psc-docs A Markdown documentation generator for PureScript code
16−- psc-bundle Bundles together CommonJS modules produced by `psc` into a
17− single JavaScript file; useful for running in the browser.
18−- psc-publish Generates documentation packages for uploading to Pursuit
19−
20−Copy these files anywhere on your PATH.
21−
bundle/build.shdeleted−46
@@ -1,46 +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-docs/psc-docs
22−strip ../dist/build/psc-publish/psc-publish
23−strip ../dist/build/psc-bundle/psc-bundle
24−
25−# Copy files to staging directory
26−cp ../dist/build/psc/psc build/purescript/
27−cp ../dist/build/psci/psci build/purescript/
28−cp ../dist/build/psc-docs/psc-docs build/purescript/
29−cp ../dist/build/psc-publish/psc-publish build/purescript/
30−cp ../dist/build/psc-bundle/psc-bundle build/purescript/
31−cp README build/purescript/
32−cp ../LICENSE build/purescript/
33−cp ../INSTALL.md build/purescript/
34−
35−# Make the binary bundle
36−pushd build > /dev/null
37−tar -zcvf ../$OS.tar.gz purescript
38−popd > /dev/null
39−
40−# Calculate the SHA hash
41−shasum $OS.tar.gz > $OS.sha
42−
43−# Remove the staging directory
44−rm -rf build/
45−
46−popd > /dev/null
bundle/winbuild.shdeleted−43
@@ -1,43 +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-docs/psc-docs.exe
18−strip ../dist/build/psc-publish/psc-publish.exe
19−strip ../dist/build/psc-bundle/psc-bundle.exe
20−
21−# Copy files to staging directory
22−cp ../dist/build/psc/psc.exe build/purescript/
23−cp ../dist/build/psci/psci.exe build/purescript/
24−cp ../dist/build/psc-docs/psc-docs.exe build/purescript/
25−cp ../dist/build/psc-publish/psc-publish.exe build/purescript/
26−cp ../dist/build/psc-bundle/psc-bundle.exe build/purescript/
27−cp README build/purescript/
28−cp ../LICENSE build/purescript/
29−cp ../INSTALL.md build/purescript/
30−
31−# Make the binary bundle
32−pushd build
33−tar -zcvf ../win64.tar.gz purescript
34−popd
35−
36−# Calculate the MD5 hash
37−md5sum win64.tar.gz > win64.md5
38−
39−# Remove the staging directory
40−rm -rf build/
41−
42−popd
43−
core-tests/.gitignoredeleted−2
@@ -1,2 +0,0 @@
1−bower_components/
2−output/
core-tests/test-everything.shdeleted−77
@@ -1,77 +0,0 @@
1−#!/bin/bash
2−
3−set -e
4−
5−force_recompile='false'
6−force_reinstall='false'
7−
8−while getopts 'ci' flag; do
9− case "${flag}" in
10− c) force_recompile='true' ;;
11− i) force_reinstall='true' ;;
12− *) error "Unexpected option ${flag}" ;;
13− esac
14−done
15−
16−if [ "$force_reinstall" = "true" ] && [ -d "bower_components" ]; then
17− echo "Reinstalling core packages..."
18− rm -r bower_components
19−fi
20−
21−npm install bower
22−
23−node_modules/.bin/bower i \
24− purescript-prelude \
25− purescript-eff \
26− purescript-st \
27− purescript-integers \
28− purescript-functions \
29− purescript-console \
30− purescript-profunctor \
31− purescript-contravariant \
32− purescript-parallel \
33− purescript-control \
34− purescript-tailrec \
35− purescript-maps \
36− purescript-free \
37− purescript-transformers \
38− purescript-exists \
39− purescript-monoid \
40− purescript-either \
41− purescript-maybe \
42− purescript-inject \
43− purescript-graphs \
44− purescript-enums \
45− purescript-unfoldable \
46− purescript-coproducts \
47− purescript-lazy \
48− purescript-distributive \
49− purescript-identity \
50− purescript-bifunctors \
51− purescript-const \
52− purescript-sets \
53− purescript-quickcheck \
54− purescript-foreign \
55− purescript-foldable-traversable \
56− purescript-tuples \
57− purescript-strings \
58− purescript-arrays \
59− purescript-random \
60− purescript-refs \
61− purescript-globals \
62− purescript-exceptions \
63− purescript-validation \
64− purescript-parallel \
65− purescript-proxy \
66− purescript-semirings \
67− purescript-math \
68− purescript-generics
69−
70−if [ "$force_recompile" = "true" ] && [ -d "output" ]; then
71− echo "Recompiling..."
72− rm -r output
73−fi
74−
75−../dist/build/psc/psc tests/*/*.purs \
76− 'bower_components/purescript-*/src/**/*.purs' \
77− --ffi 'bower_components/purescript-*/src/**/*.js'
core-tests/tests/generic-deriving/Main.pursdeleted−27
@@ -1,27 +0,0 @@
1−module GenericDeriving where
2−
3−import Prelude
4−
5−import Control.Monad.Eff (Eff())
6−import Control.Monad.Eff.Console (CONSOLE())
7−import Data.Generic
8−
9−data Void
10−
11−derive instance genericVoid :: Generic Void
12−
13−data A a
14− = A Number String
15− | B Int
16− | C (Array (A a))
17− | D { "asgård" :: a }
18− | E Void
19−
20−derive instance genericA :: (Generic b) => Generic (A b)
21−
22−newtype X b = X b
23−
24−derive instance genericX :: Generic (X String)
25−
26−main :: forall eff. Eff (console :: CONSOLE | eff) Unit
27−main = Control.Monad.Eff.Console.log (gShow (D { "asgård": C [ A 1.0 "test", B 42, D { "asgård": true } ] }))
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/1071.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith KindsDoNotUnify
2−module Main where
3−
4−class Foo a b where
5− foo :: a -> b
6−
7−bar :: forall a. (Foo a) => a -> a
8−bar a = a
examples/failing/1169.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith IncorrectConstructorArity
2−module Test where
3−
4−data Outer a = Outer a
5−
6−data Inner a b = Inner a b
7−
8−test1 :: forall a b. Outer (Inner a b) -> Boolean
9−test1 (Outer (Inner _)) = true
10−
11−test2 :: forall a b. Inner a b -> Boolean
12−test2 (Inner _) = true
examples/failing/1175.pursdeleted−11
@@ -1,11 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module X where
3−
4−class Foo where
5− foo :: String
6−
7−instance f :: Foo where
8− foo = "a"
9− where
10− bar :: String
11− bar = 1
examples/failing/1310.pursdeleted−18
@@ -1,18 +0,0 @@
1−-- @shouldFailWith NoInstanceFound
2−
3−module Issue1310 where
4−
5−import Prelude
6−import Control.Monad.Eff
7−import Control.Monad.Eff.Console
8−
9−class Inject f g where
10− inj :: forall a. f a -> g a
11−
12−instance inject :: Inject f f where
13− inj x = x
14−
15−foreign import data Oops :: !
16−
17−main :: forall eff. Eff (oops :: Oops | eff) Unit
18−main = inj (log "Oops")
examples/failing/1570.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith ExpectedType
2−module M where
3−
4−data F a = F a
5−
6−test = \(x :: F) -> x
examples/failing/1733.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- @shouldFailWith UnknownValue
2−
3−module Main where
4−
5−import Thingy as Thing
6−
7−main = Thing.doesntExist "hi"
8−
9−module Thingy where
10−
11−foo :: Int
12−foo = 1
13−
examples/failing/365.pursdeleted−14
@@ -1,14 +0,0 @@
1−-- @shouldFailWith CycleInDeclaration
2−module Main where
3−
4−import Prelude
5−
6−class C a where
7− f :: a -> a
8− g :: a -> a
9−
10−instance cS :: C String where
11− f s = s
12− g = f
13−
14−main = g "Done"
examples/failing/438.pursdeleted−15
@@ -1,15 +0,0 @@
1−-- @shouldFailWith PossiblyInfiniteInstance
2−
3−-- See issue 438 for details: this test is mainly here to test that code like
4−-- this doesn't cause the compiler to loop.
5−
6−module Main where
7−
8−import Prelude
9−
10−data Fix f = In (f (Fix f))
11−
12−instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where
13− eq (In f) (In g) = f == g
14−
15−example = In [] == In []
examples/failing/881.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- @shouldFailWith DuplicateValueDeclaration
2−module Main where
3−
4−data X = X | Y
5−
6−class Foo a where
7− foo :: a -> a
8− bar :: a
9−
10−instance fooX :: Foo X where
11− foo X = X
12− bar = X
13− foo Y = Y
examples/failing/ArrayType.pursdeleted−14
@@ -1,14 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−
3−module Main where
4−
5−import Prelude
6−import Control.Monad.Eff.Console
7−
8−bar :: Number -> Number -> Number
9−bar n m = n + m
10−
11−foo = x `bar` y
12− where
13− x = 1
14− y = []
examples/failing/Arrays.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−foreign import (!!) :: forall a. Array a -> Int -> a
7−
8−test = \arr -> arr !! (0 !! 0)
examples/failing/CaseBinderLengthsDiffer.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith CaseBinderLengthDiffers
2−module Main where
3−
4−test = case 1, 2 of
5− 1, 2, 3 -> 42
6− _, _ -> 43
examples/failing/CaseDoesNotMatchAllConstructorArgs.pursdeleted−15
@@ -1,15 +0,0 @@
1−-- @shouldFailWith IncorrectConstructorArity
2−module Main where
3−
4−import Prelude
5−
6−data Person = Person String Int
7−
8−data TwoPeople = Two Person Person
9−
10−getName p = case p of
11− (Two (Person n) (Person n2 a2)) -> n
12− _ -> "Unknown"
13−
14−
15−name = getName (Two (Person "Jimmy" 20) (Person "" 1))
examples/failing/ConflictingExports.pursdeleted−16
@@ -1,16 +0,0 @@
1−-- @shouldFailWith ScopeConflict
2−module A where
3−
4− thing :: Int
5− thing = 1
6−
7−module B where
8−
9− thing :: Int
10− thing = 2
11−
12−-- Fails here because re-exporting forces any scope conflicts to be resolved
13−module Main (module A, module B) where
14−
15− import A
16− import B
examples/failing/ConflictingExports2.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- @shouldFailWith ScopeConflict
2−module A where
3−
4− thing :: Int
5− thing = 1
6−
7−-- Fails here because re-exporting forces any scope conflicts to be resolved
8−module Main (thing, module A) where
9−
10− import A
11−
12− thing :: Int
13− thing = 2
examples/failing/ConflictingImports.pursdeleted−19
@@ -1,19 +0,0 @@
1−-- @shouldFailWith ScopeConflict
2−module A where
3−
4− thing :: Int
5− thing = 1
6−
7−module B where
8−
9− thing :: Int
10− thing = 2
11−
12−module Main where
13−
14− import A
15− import B
16−
17− -- Error due to referencing `thing` which is in scope as A.thing and B.thing
18− what :: Int
19− what = thing
examples/failing/ConflictingImports2.pursdeleted−16
@@ -1,16 +0,0 @@
1−-- @shouldFailWith ScopeConflict
2−module A where
3−
4− thing :: Int
5− thing = 1
6−
7−module Main where
8−
9− import A
10−
11− thing :: Int
12− thing = 2
13−
14− -- Error due to referencing `thing` which is in scope as A.thing and Main.thing
15− what :: Int
16− what = thing
examples/failing/ConflictingQualifiedImports.pursdeleted−17
@@ -1,17 +0,0 @@
1−-- @shouldFailWith ScopeConflict
2−module A where
3−
4− thing :: Int
5− thing = 1
6−
7−module B where
8−
9− thing :: Int
10− thing = 2
11−
12−module Main where
13−
14− import A as X
15− import B as X
16−
17− foo = X.thing
examples/failing/ConflictingQualifiedImports2.pursdeleted−15
@@ -1,15 +0,0 @@
1−-- @shouldFailWith ScopeConflict
2−module A where
3−
4− thing :: Int
5− thing = 1
6−
7−module B where
8−
9− thing :: Int
10− thing = 2
11−
12−module Main (module X) where
13−
14− import A as X
15− import B as X
examples/failing/Do.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith InvalidDoBind
2−-- @shouldFailWith InvalidDoLet
3−module Main where
4−
5−import Prelude
6−
7−test1 = do let x = 1
8−
9−test2 y = do x <- y
10−
11−test3 = do return 1
12− return 2
examples/failing/DoNotSuggestComposition.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−-- TODO: Check that this does not produce a "function composition is (<<<)"
3−-- suggestion.
4−module DoNotSuggestComposition where
5−
6−import Prelude
7−
8−x = { y: 3 }
9−
10−foo :: String -> String
11−foo y = y
12−
13−bar = foo x
examples/failing/DoNotSuggestComposition2.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith CannotApplyFunction
2−-- TODO: Check that this does not produce a "function composition is (<<<)"
3−-- suggestion.
4−
5−module DoNotSuggestComposition2 where
6−
7−foo = let x = { y: 3 } in x 2
examples/failing/DuplicateDeclarationsInLet.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith OverlappingNamesInLet
2−module Main where
3−
4−import Prelude
5−
6−foo = a
7− where
8− a :: Number
9− a = 1
10−
11− a :: Number
12− a = 2
examples/failing/DuplicateProperties1.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module DuplicateProperties where
3−
4−import Prelude
5−
6−foreign import data Test :: # * -> *
7−
8−foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
9−
10−foreign import hasX :: Test (x :: Unit, y :: Unit)
11−
12−baz = subtractX (subtractX hasX)
examples/failing/DuplicateProperties2.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith DuplicateLabel
2−module DuplicateProperties where
3−
4−import Prelude
5−
6−foreign import data Test :: # * -> *
7−
8−foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
9−
10−foreign import hasX :: forall r. Test (x :: Unit, y :: Unit | r)
11−
12−baz = subtractX (subtractX hasX)
examples/failing/DuplicateTypeVars.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith DuplicateTypeArgument
2−module Main where
3−
4−import Prelude
5−
6−type Foo a a = a
examples/failing/Eff.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module Main where
3−
4−import Prelude
5−import Control.Monad.Eff
6−import Control.Monad.ST
7−import Control.Monad.Eff.Console
8−
9−test = pureST (do
10− ref <- newSTRef 0
11− log "ST"
12− modifySTRef ref $ \n -> n + 1
13− readSTRef ref)
examples/failing/EmptyCase.pursdeleted−4
@@ -1,4 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Main where
3−
4−error err = case err of \_ -> 1
examples/failing/EmptyClass.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Main where
3−
4−class Foo x where
5−
6−bar :: String
7−bar = "hello"
examples/failing/EmptyDo.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−
3−module Main where
4−
5−main = do
6−
examples/failing/ExtraRecordField.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith AdditionalProperty
2−module ExtraRecordField where
3−
4−import Prelude ((<>))
5−
6−full :: { first :: String, last :: String } -> String
7−full p = p.first <> " " <> p.last
8−
9−oops = full { first: "Jane", last: "Smith", age: 29 }
examples/failing/Foldable.pursdeleted−17
@@ -1,17 +0,0 @@
1−-- @shouldFailWith CycleInDeclaration
2−module Main where
3−
4−import Prelude
5−
6−class Foldable f where
7− fold :: forall a b. (a -> b -> b) -> b -> f a -> b
8− size :: forall a. f a -> Number
9−
10−data L a = C a (L a) | N
11−
12−instance foldableL :: Foldable L where
13− fold _ z N = z
14− fold f z (C x xs) = x `f` (fold f z xs)
15− size = fold (const ((+) 1.0)) 0.0
16−
17−x = size (C 1 (C 2 (C 3 N)))
examples/failing/ImportHidingModule.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith ImportHidingModule
2−module A where
3− x = 1
4−
5−module B (module B, module A) where
6− import A
7− y = 1
8−
9−module C where
10− import B hiding (module A)
examples/failing/InfiniteKind.pursdeleted−5
@@ -1,5 +0,0 @@
1−-- @shouldFailWith InfiniteKind
2−
3−module Main where
4−
5−data F a = F (a a)
examples/failing/InfiniteType.pursdeleted−5
@@ -1,5 +0,0 @@
1−-- @shouldFailWith InfiniteType
2−
3−module Main where
4−
5−f a = a a
examples/failing/InstanceExport.pursdeleted−19
@@ -1,19 +0,0 @@
1−-- @shouldFailWith TransitiveExportError
2−module InstanceExport (S(..), f) where
3−
4−import Prelude
5−
6−newtype S = S String
7−
8−class F a where
9− f :: a -> String
10−
11−instance fs :: F S where
12− f (S s) = s
13−
14−module Test where
15−
16−import InstanceExport
17−import Prelude
18−
19−test = f $ S "Test"
examples/failing/IntOutOfRange.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith IntOutOfRange
2−
3−module Main where
4−
5−n :: Int
6−n = 2147483648
examples/failing/KindError.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith KindsDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−data KindError f a = One f | Two (f a)
examples/failing/KindStar.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith ExpectedType
2−
3−module X where
4−
5−data List a = Nil | Cons a (List a)
6−
7−test :: List
8−test = Nil
examples/failing/LeadingZeros1.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Main where
3−
4−import Prelude
5−
6−x = 01
examples/failing/LeadingZeros2.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Main where
3−
4−import Prelude
5−
6−x = 00.1
examples/failing/Let.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith CycleInDeclaration
2−module Main where
3−
4−import Prelude
5−
6−test = let x = x in x
examples/failing/MPTCs.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith KindsDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−class Foo a where
7− f :: a -> a
8−
9−instance fooStringString :: Foo String String where
10− f a = a
examples/failing/MissingClassExport.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith TransitiveExportError
2−module Test (bar) where
3−
4−import Prelude
5−
6−class Foo a where
7− bar :: a -> a
examples/failing/MissingClassMemberExport.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith TransitiveExportError
2−module Test (Foo) where
3−
4−import Prelude
5−
6−class Foo a where
7− bar :: a -> a
examples/failing/MissingRecordField.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith PropertyIsMissing
2−module MissingRecordField where
3−
4−import Prelude ((>))
5−
6−john = { first: "John", last: "Smith" }
7−
8−isOver50 p = p.age > 50.0
9−
10−result = isOver50 john
examples/failing/MultipleErrors.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−-- @shouldFailWith TypesDoNotUnify
3−module MultipleErrors where
4−
5−import Prelude
6−
7−foo :: Int -> Int
8−foo 0 = "Test"
9−foo n = bar (n - 1)
10−
11−bar :: Int -> Int
12−bar 0 = "Test"
13−bar n = foo (n - 1)
examples/failing/MultipleErrors2.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith UnknownValue
2−-- @shouldFailWith UnknownValue
3−module MultipleErrors2 where
4−
5−import Prelude
6−
7−foo = itDoesntExist
8−
9−bar = neitherDoesThis
examples/failing/MutRec.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith CycleInDeclaration
2−-- @shouldFailWith CycleInDeclaration
3−module MutRec where
4−
5−import Prelude
6−
7−x = y
8−
9−y = x
examples/failing/MutRec2.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith CycleInDeclaration
2−module Main where
3−
4−import Prelude
5−
6−x = x
examples/failing/NewtypeMultiArgs.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith InvalidNewtype
2−module Main where
3−
4−import Prelude
5−
6−newtype Thing = Thing String Boolean
examples/failing/NewtypeMultiCtor.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith InvalidNewtype
2−module Main where
3−
4−import Prelude
5−
6−newtype Thing = Thing String | Other
examples/failing/NullaryAbs.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Main where
3−
4−import Prelude
5−
6−func = \ -> "no"
examples/failing/Object.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith PropertyIsMissing
2−module Main where
3−
4−import Prelude
5−
6−test o = o.foo
7−
8−test1 = test {}
examples/failing/OperatorAliasNoExport.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith TransitiveExportError
2−module Test ((?!)) where
3−
4−infixl 4 what as ?!
5−
6−what :: forall a b. a -> b -> a
7−what a _ = a
examples/failing/OrphanInstance.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith OrphanInstance
2−module Class where
3−
4− class C a where
5− op :: a -> a
6−
7−module Test where
8−
9− import Class
10−
11− instance cBoolean :: C Boolean where
12− op a = a
examples/failing/OverlappingArguments.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith OverlappingArgNames
2−module OverlappingArguments where
3−
4−import Prelude
5−
6−f x x = x
examples/failing/OverlappingBinders.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith OverlappingArgNames
2−module OverlappingBinders where
3−
4−import Prelude
5−
6−data S a = S a (S a)
7−
8−f x = case x of
9− (S y (S y@(S z zs))) -> y
examples/failing/OverlappingReExport.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith DuplicateValueExport
2−module A where
3− x = true
4−
5−module B where
6− x = false
7−
8−module C (module A, module M2) where
9− import A
10− import qualified B as M2
examples/failing/OverlappingVars.pursdeleted−15
@@ -1,15 +0,0 @@
1−-- @shouldFailWith NoInstanceFound
2−module Main where
3−
4−import Prelude
5−
6−class OverlappingVars a where
7− f :: a -> a
8−
9−data Foo a b = Foo a b
10−
11−instance overlappingVarsFoo :: OverlappingVars (Foo a a) where
12− f a = a
13−
14−test = f (Foo "" 0)
15−
examples/failing/Rank2Types.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−foreign import test :: (forall a. a -> a) -> Number
7−
8−test1 = test (\n -> n + 1)
examples/failing/Reserved.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Main where
3−
4−import Prelude
5−
6−(<) :: Number -> Number -> Number
7−(<) a b = !(a >= b)
examples/failing/RowConstructors1.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith KindsDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−data Foo = Bar
7−type Baz = { | Foo }
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/failing/RowConstructors2.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith KindsDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−type Foo r = (x :: Number | r)
7−type Bar = { | Foo }
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/failing/RowConstructors3.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith KindsDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−type Foo = { x :: Number }
7−type Bar = { | Foo }
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/failing/SkolemEscape.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith EscapedSkolem
2−module Main where
3−
4−import Prelude
5−
6−foreign import foo :: (forall a. a -> a) -> Number
7−
8−test = \x -> foo x
examples/failing/SkolemEscape2.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith EscapedSkolem
2−module Main where
3−
4−import Prelude
5−import Control.Monad.Eff
6−import Control.Monad.ST
7−
8−test _ = do
9− r <- runST (newSTRef 0)
10− return 0
examples/failing/SuggestComposition.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−-- TODO: Ensure the correct suggestion is produced.
3−module SuggestComposition where
4−
5−import Prelude
6−
7−f = g . g where g = (+1)
examples/failing/Superclasses1.pursdeleted−14
@@ -1,14 +0,0 @@
1−-- @shouldFailWith NoInstanceFound
2−module Main where
3−
4−import Prelude
5−
6−class Su a where
7− su :: a -> a
8−
9−class (Su a) <= Cl a where
10− cl :: a -> a -> a
11−
12−instance clNumber :: Cl Number where
13− cl n m = n + m
14−
examples/failing/Superclasses2.pursdeleted−13
@@ -1,13 +0,0 @@
1−-- @shouldFailWith CycleInTypeSynonym
2−-- TODO: Should this have its own error, perhaps CycleInTypeClassDeclaration?
3−module CycleInSuperclasses where
4−
5−import Prelude
6−
7−class (Foo a) <= Bar a
8−
9−class (Bar a) <= Foo a
10−
11−instance barString :: Bar String
12−
13−instance fooString :: Foo String
examples/failing/Superclasses3.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith UndefinedTypeVariable
2−module UnknownSuperclassTypeVar where
3−
4−import Prelude
5−
6−class Foo a
7−
8−class (Foo b) <= Bar a
examples/failing/Superclasses5.pursdeleted−25
@@ -1,25 +0,0 @@
1−-- @shouldFailWith NoInstanceFound
2−
3−module Main where
4−
5−import Prelude
6−
7−class Su a where
8− su :: a -> a
9−
10−class (Su (Array a)) <= Cl a where
11− cl :: a -> a -> a
12−
13−instance suNumber :: Su Number where
14− su n = n + 1.0
15−
16−instance suArray :: (Su a) => Su (Array a) where
17− su [x] = [su x]
18−
19−instance clNumber :: Cl Number where
20− cl n m = n + m
21−
22−test :: forall a. (Cl a) => a -> Array a
23−test x = su [cl x x]
24−
25−main = Control.Monad.Eff.Console.print $ test 10.0
examples/failing/TopLevelCaseNoArgs.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith DuplicateValueDeclaration
2−module Main where
3−
4−import Prelude
5−
6−foo :: Number
7−foo = 1
8−foo = 2
examples/failing/TransitiveDctorExport.pursdeleted−5
@@ -1,5 +0,0 @@
1−-- @shouldFailWith TransitiveExportError
2−module Main (Y(..)) where
3−
4−type X = Int
5−data Y = Y X
examples/failing/TransitiveSynonymExport.pursdeleted−5
@@ -1,5 +0,0 @@
1−-- @shouldFailWith TransitiveExportError
2−module Main (Y()) where
3−
4−type X = Int
5−type Y = X
examples/failing/TypeClassInstances.pursdeleted−11
@@ -1,11 +0,0 @@
1−-- @shouldFailWith MissingClassMember
2−module Main where
3−
4−import Prelude
5−
6−class A a where
7− a :: a -> String
8− b :: a -> Number
9−
10−instance aString :: A String where
11− a s = s
examples/failing/TypeClasses2.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith NoInstanceFound
2−module Main where
3−
4−import Prelude ()
5−
6−class Show a where
7− show :: a -> String
8−
9−test = show "testing"
examples/failing/TypeError.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−test = 1 ++ "A"
examples/failing/TypeSynonyms.pursdeleted−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith CycleInTypeSynonym
2−module Main where
3−
4−import Prelude
5−
6−type T1 = Array T2
7−
8−type T2 = T1
examples/failing/TypeSynonyms2.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith TypeSynonymInstance
2−module Main where
3−
4−import Prelude
5−
6−class Foo a where
7− foo :: a -> String
8−
9−type Bar = String
10−
11−instance fooBar :: Foo Bar where
12− foo s = s
examples/failing/TypeSynonyms3.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith TypeSynonymInstance
2−module Main where
3−
4−import Prelude
5−
6−class Foo a where
7− foo :: a -> String
8−
9−type Bar = String
10−
11−instance fooBar :: Foo Bar where
12− foo s = s
examples/failing/TypeSynonyms4.pursdeleted−11
@@ -1,11 +0,0 @@
1−-- @shouldFailWith PartiallyAppliedSynonym
2−module TypeSynonyms4 where
3−
4−import Prelude
5−
6−type F x y = x -> y
7−
8−type G x = F x
9−
10−f :: G String String -> String
11−f k = k "Done"
examples/failing/TypeSynonyms5.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith CycleInTypeSynonym
2−module Main where
3−
4−import Prelude
5−
6−type T = T
examples/failing/TypeWildcards1.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module TypeWildcards where
3−
4−import Prelude
5−
6−type Test = _
7−
examples/failing/TypeWildcards2.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module TypeWildcards where
3−
4−import Prelude
5−
6−data Test = Test _
7−
examples/failing/TypeWildcards3.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module TypeWildcards where
3−
4−import Prelude
5−
6−data Foo a = Foo
7−
8−instance showFoo :: Show (Foo _) where
9− show Foo = "Foo"
10−
examples/failing/TypedBinders.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Main where
3−
4−import Prelude
5−
6−test = (\f :: Int -> Int -> f 10) id
7−
8−main = do
9− let t1 = test
10− Control.Monad.Eff.Console.log "Done"
examples/failing/TypedBinders2.pursdeleted−9
@@ -1,9 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−main = do
7− s :: String <- Control.Monad.Eff.Console.log "Foo"
8− Control.Monad.Eff.Console.log "Done"
9−
examples/failing/TypedBinders3.pursdeleted−12
@@ -1,12 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−module Main where
3−
4−import Prelude
5−
6−test = case 1 of
7− (0 :: String) -> true
8− _ -> false
9−
10−main = do
11− let t = test
12− Control.Monad.Eff.Console.log "Done"
examples/failing/UnderscoreModuleName.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−module Bad_Module where
3−
4−import Prelude
5−
6−main = Control.Monad.Eff.Console.log "Done"
examples/failing/UnifyInTypeInstanceLookup.pursdeleted−22
@@ -1,22 +0,0 @@
1−-- @shouldFailWith NoInstanceFound
2−-- See issue #390.
3−-- TODO: Improve this error.
4−module Main where
5−
6−import Prelude
7−
8−data Z = Z
9−data S n = S n
10−
11−data T
12−data F
13−
14−class EQ x y b
15−instance eqT :: EQ x x T
16−instance eqF :: EQ x y F
17−
18−foreign import test :: forall a b. (EQ a b T) => a -> b -> a
19−
20−foreign import anyNat :: forall a. a
21−
22−test1 = test anyNat (S Z)
examples/failing/UnknownType.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- @shouldFailWith UnknownType
2−module Main where
3−
4−import Prelude
5−
6−test :: Number -> Something
7−test = {}
examples/manual/QualifiedNames.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Data.Either where
2−
3−import Prelude
4−
5−data Either a b = Left a | Right b
6−
7−module Main where
8−
9−either :: forall a b c. (a -> c) -> (b -> c) -> Data.Either.Either a b -> c
10−either f _ (Data.Either.Left x) = f x
11−either _ g (Data.Either.Right y) = g y
12−
13−main = Control.Monad.Eff.Console.log (either id id (Data.Either.Left "Done"))
examples/manual/failing/ArgLengthMismatch.pursdeleted−6
@@ -1,6 +0,0 @@
1−module ArgLengthMismatch where
2−
3−import Prelude
4−
5−f x y = true
6−f = false
examples/manual/failing/ExportExplicit.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- should fail as z does not exist in the module
2−module M1 (x, y, z) where
3−
4−import Prelude
5−
6−x = 1
7−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 = Control.Monad.Eff.Console.log "Done"
examples/manual/failing/ExportExplicit2.pursdeleted−7
@@ -1,7 +0,0 @@
1−-- should fail as Y is not a data constructor for X
2−module M1 (X(Y)) where
3−
4−import Prelude
5−
6−data X = X
7−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 = Control.Monad.Eff.Console.log "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−8
@@ -1,8 +0,0 @@
1−module RedefinedFixity where
2−
3−import Prelude
4−
5−(!?) x y = x + y
6−
7−infix 2 !?
8−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 = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ExportedInstanceDeclarations.pursdeleted−43
@@ -1,43 +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−import Prelude
12−
13−data Const a b = Const a
14−
15−class Foo a where
16− foo :: a
17−
18−data NonexportedType = NonexportedType
19−
20−class NonexportedClass a where
21− notExported :: a
22−
23−-- There are three places that a nonexported type or type class can occur,
24−-- leading an instance to count as non-exported:
25−-- * Constraints
26−-- * The type class itself
27−-- * The instance types
28−
29−-- Case 1: constraints
30−instance nonExportedFoo :: (NonexportedClass a) => Foo a where
31− foo = notExported
32−
33−-- Another instance of case 1:
34−instance nonExportedFoo2 :: (Foo NonexportedType) => Foo (a -> a) where
35− foo = id
36−
37−-- Case 2: type class
38−instance nonExportedNonexportedType :: NonexportedClass (Const Number a) where
39− notExported = Const 0
40−
41−-- Case 3: instance types
42−instance constFoo :: Foo (Const NonexportedType b) where
43− 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 = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ImportQualified.pursdeleted−12
@@ -1,12 +0,0 @@
1−module M1 where
2−
3− log x = x
4−
5−module Main where
6−
7− import Prelude
8− import Control.Monad.Eff
9− import M1
10− import qualified Control.Monad.Eff.Console as C
11−
12− main = C.log (log "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 = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ShadowedName.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−done :: String
7−done = let str = "Not yet done" in
8− let str = "Done" in str
9−
10−main = Control.Monad.Eff.Console.log done
examples/manual/passing/TransitiveImport.pursdeleted−24
@@ -1,24 +0,0 @@
1−module Test where
2−
3− import Prelude
4−
5− class TestCls a where
6− test :: a -> a
7−
8− instance unitTestCls :: TestCls Unit where
9− test _ = unit
10−
11−module Middle where
12−
13− middle = Test.test
14−
15−module Main where
16−
17− import Prelude
18− import Middle
19− import Control.Monad.Eff.Console
20−
21− main = do
22− print (middle unit)
23− trace "Done"
24− return unit
examples/manual/passing/WildcardType.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−f1 :: (_ -> _) -> _
7−f1 g = g 1
8−
9−f2 :: _ -> _
10−f2 _ = "Done"
11−
12−main = Control.Monad.Eff.Console.log $ f1 f2
13−
examples/passing/1185.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−data Person = Person String Boolean
4−
5−getName :: Person -> String
6−getName p = case p of
7− Person name true -> name
8− _ -> "Unknown"
9−
10−name :: String
11−name = getName (Person "John Smith" true)
12−
13−main = Control.Monad.Eff.Console.log "Done"
examples/passing/1335.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console (log)
5−
6−x :: forall a. a -> String
7−x a = y "Done"
8− where
9− y :: forall a. (Show a) => a -> String
10− y a = show (a :: a)
11−
12−main = log (x 0)
examples/passing/1570.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−test :: forall a. a -> a
4−test = \(x :: a) -> x
5−
6−main = Control.Monad.Eff.Console.log "Done"
examples/passing/1664.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−
7−data Identity a = Identity a
8−
9−newtype IdentityEff e a = IdentityEff (Eff e (Identity a))
10−
11−test :: forall e a. IdentityEff e a -> IdentityEff e Unit
12−test (IdentityEff action) = IdentityEff $ do
13− (Identity x :: Identity _) <- action
14− return $ Identity unit
15−
16−main = log "Done"
examples/passing/1697.pursdeleted−24
@@ -1,24 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−_2 :: forall a. a -> a
6−_2 a = a
7−
8−x :: forall m. (Monad m) => m Unit
9−x = do
10− _ <- pure unit
11− pure unit
12−
13−y :: forall m. (Monad m) => m Unit
14−y = do
15− _ <- pure unit
16− pure unit
17−
18−wtf :: forall m. (Monad m) => m Unit
19−wtf = do
20− _ <- pure unit
21− let tmp = _2 1
22− pure unit
23−
24−main = Control.Monad.Eff.Console.log "Done"
examples/passing/652.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class Foo a b
6−
7−class Bar a c
8−
9−class (Foo a b, Bar a c) <= Baz a b c
10−
11−instance foo :: Foo (a -> b) a
12−
13−instance bar :: Bar (a -> b) b
14−
15−instance baz :: (Eq a) => Baz (a -> b) a b
16−
17−main = Control.Monad.Eff.Console.log "Done"
examples/passing/810.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Maybe a = Nothing | Just a
6−
7−test :: forall a. Maybe a -> Maybe a
8−test m = o.x
9− where
10− o = case m of Nothing -> { x : Nothing }
11− Just a -> { x : Just a }
12−
13−main = Control.Monad.Eff.Console.log "Done"
examples/passing/862.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−id' = (\x -> x) <$> \y -> y
7−
8−main = log (id' "Done")
examples/passing/922.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−import Control.Monad.Eff.Console
6−
7−class Default a where
8− def :: a
9−
10−instance defaultString :: Default String where
11− def = "Done"
12−
13−data I a = I a
14−
15−instance defaultI :: (Default a) => Default (I a) where
16− def = I def
17−
18−main = do
19− case def of
20− I s -> log s
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− apply :: 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− apply (Just f) (Just a) = Just (f a)
14− apply _ _ = Nothing
15−
16−main = Control.Monad.Eff.Console.log "Done"
examples/passing/ArrayType.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class Pointed p where
6− point :: forall a. a -> p a
7−
8−instance pointedArray :: Pointed Array where
9− point a = [a]
10−
11−main = Control.Monad.Eff.Console.log "Done"
examples/passing/Auto.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Auto s i o = Auto { state :: s, step :: s -> i -> o }
6−
7−type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r
8−
9−exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o
10−exists = \state step f -> f (Auto { state: state, step: step })
11−
12−run :: forall i o. SomeAuto i o -> i -> o
13−run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)
14−
15−main = Control.Monad.Eff.Console.log "Done"
examples/passing/AutoPrelude.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−f x = x * 10.0
7−g y = y - 10.0
8−
9−main = log $ show $ (f <<< g) 100.0
examples/passing/AutoPrelude2.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import qualified Prelude as P
5−import Control.Monad.Eff.Console
6−
7−f :: forall a. a -> a
8−f = P.id
9−
10−main = P.($) log ((f P.<<< f) "Done")
examples/passing/BindersInFunctions.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Test.Assert
5−
6−snd = \[_, y] -> y
7−
8−main = do
9− let ts = snd [1.0, 2.0]
10− assert' "Incorrect result from 'snd'." (ts == 2.0)
11− Control.Monad.Eff.Console.log "Done"
examples/passing/BindingGroups.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−foo = bar
6− where bar r = r + 1.0
7−
8−r = foo 2.0
9−
10−main = Control.Monad.Eff.Console.log "Done"
examples/passing/BlockString.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−foo :: String
6−foo = """foo"""
7−
8−main = Control.Monad.Eff.Console.log "Done"
examples/passing/CaseInDo.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−import Control.Monad.Eff
6−
7−doIt :: forall eff. Eff eff Boolean
8−doIt = return true
9−
10−set = do
11− log "Testing..."
12− case 0 of
13− 0 -> doIt
14− _ -> return false
15−
16−main = do
17− b <- set
18− case b of
19− true -> log "Done"
examples/passing/CaseMultipleExpressions.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−import Control.Monad.Eff
6−
7−doIt :: forall eff. Eff eff Boolean
8−doIt = return true
9−
10−set = do
11− log "Testing..."
12− case 42, 10 of
13− 42, 10 -> doIt
14− _ , _ -> return false
15−
16−main = do
17− b <- set
18− case b of
19− true -> log "Done"
examples/passing/CaseStatement.pursdeleted−21
@@ -1,21 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data A = A | B | C
6−
7−f a _ A = a
8−f _ a B = a
9−f _ _ C = "Done"
10−
11−g a _ A = a
12−g _ b B = b
13−g _ _ C = C
14−
15−data M a = N | J a
16−
17−h f N a = a
18−h f a N = a
19−h f (J a) (J b) = J (f a b)
20−
21−main = Control.Monad.Eff.Console.log $ f "Done" "Failed" A
examples/passing/CheckFunction.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0
6−
7−main = Control.Monad.Eff.Console.log "Done"
examples/passing/CheckSynonymBug.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−length :: forall a. Array a -> Int
6−length _ = 0
7−
8−type Foo a = Array a
9−
10−foo _ = length ([] :: Foo Number)
11−
12−main = Control.Monad.Eff.Console.log "Done"
examples/passing/CheckTypeClass.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Bar a = Bar
6−data Baz
7−
8−class Foo a where
9− foo :: Bar a -> Baz
10−
11−foo_ :: forall a. (Foo a) => a -> Baz
12−foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)
13−
14−mkBar :: forall a. a -> Bar a
15−mkBar _ = Bar
16−
17−main = Control.Monad.Eff.Console.log "Done"
18−
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 = Control.Monad.Eff.Console.log "Done"
examples/passing/ClassRefSyntax.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Lib (class X, go) where
2−
3− class X a where
4− go :: a -> a
5−
6−module Main where
7−
8− import Lib (class X, go)
9−
10− go' :: forall a. (X a) => a -> a
11− go' = go
12−
13− main = Control.Monad.Eff.Console.log "Done"
examples/passing/Collatz.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−
7−collatz :: Int -> Int
8−collatz n = runPure (runST (do
9− r <- newSTRef n
10− count <- newSTRef 0
11− untilE $ do
12− modifySTRef count $ (+) 1
13− m <- readSTRef r
14− writeSTRef r $ if m `mod` 2 == 0 then m / 2 else 3 * m + 1
15− return $ m == 1
16− readSTRef count))
17−
18−main = Control.Monad.Eff.Console.print $ collatz 1000
examples/passing/Comparisons.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−import Test.Assert
7−
8−main = do
9− assert (1.0 < 2.0)
10− assert (2.0 == 2.0)
11− assert (3.0 > 1.0)
12− assert ("a" < "b")
13− assert ("a" == "a")
14− assert ("z" > "a")
15− log "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 = Control.Monad.Eff.Console.log "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 Control.Monad.Eff.Console
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 (log "Hello World!")
examples/passing/DataAndType.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data A = A B
6−
7−type B = A
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/passing/DeepArrayBinder.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Test.Assert
6−
7−data List a = Cons a (List a) | Nil
8−
9−match2 :: List Number -> Number
10−match2 (Cons x (Cons y xs)) = x * y + match2 xs
11−match2 _ = 0.0
12−
13−main = do
14− let result = 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)))))))))
15− assert' "Incorrect result!" (result == 100.0)
16− Control.Monad.Eff.Console.log "Done"
examples/passing/DeepCase.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−import Control.Monad.Eff
6−import Control.Monad.ST
7−
8−f x y =
9− let
10− g = case y of
11− 0.0 -> x
12− x -> 1.0 + x * x
13− in g + x + y
14−
15−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− map f Nothing = Nothing
9− map f (Just x) = Just (f x)
10−
11−instance applyMaybe :: Apply Maybe where
12− apply (Just f) (Just x) = Just (f x)
13− apply _ _ = Nothing
14−
15−instance applicativeMaybe :: Applicative Maybe where
16− pure = Just
17−
18−instance bindMaybe :: Bind Maybe where
19− bind Nothing _ = Nothing
20− bind (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 = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "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 Control.Monad.Eff.Console
7−
8−test1 = do
9− log "Line 1"
10− log "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− Control.Monad.Eff.Console.print test2
25− Control.Monad.Eff.Console.print test3
examples/passing/EmptyDataDecls.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Test.Assert
5−
6−data Z
7−data S n
8−
9−data ArrayBox n a = ArrayBox (Array a)
10−
11−nil :: forall a. ArrayBox Z a
12−nil = ArrayBox []
13−
14−cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
15−cons' x (ArrayBox xs) = ArrayBox $ append [x] xs
16−
17−main = case cons' 1 $ cons' 2 $ cons' 3 nil of
18− ArrayBox [1, 2, 3] -> Control.Monad.Eff.Console.log "Done"
19− _ -> assert' "Failed" false
examples/passing/EmptyRow.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Foo r = Foo { | r }
6−
7−test :: Foo ()
8−test = Foo {}
9−
10−main = Control.Monad.Eff.Console.log "Done"
examples/passing/EmptyTypeClass.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class PartialP
6−
7−head :: forall a. (PartialP) => Array a -> a
8−head [x] = x
9−
10−instance allowPartials :: PartialP
11−
12−main = Control.Monad.Eff.Console.log $ head ["Done"]
examples/passing/EqOrd.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Pair a b = Pair a b
6−
7−instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
8− compare (Pair a1 b1) (Pair a2 b2) = case compare a1 a2 of
9− EQ -> compare b1 b2
10− r -> r
11−
12−instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
13− eq (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2
14−
15−main = Control.Monad.Eff.Console.print $ Pair 1.0 2.0 == Pair 1.0 2.0
examples/passing/ExplicitImportReExport.pursdeleted−16
@@ -1,16 +0,0 @@
1−-- from #1244
2−module Foo where
3−
4− foo :: Int
5− foo = 3
6−
7−module Bar (module Foo) where
8−
9− import Foo
10−
11−module Baz where
12−
13− import Bar (foo)
14−
15− baz :: Int
16− baz = foo
examples/passing/ExtendedInfixOperators.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering
6−comparing f = compare `Data.Function.on` f
7−
8−null [] = true
9−null _ = false
10−
11−test = [1.0, 2.0, 3.0] `comparing null` [4.0, 5.0, 6.0]
12−
13−main = do
14− Control.Monad.Eff.Console.print test
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− Control.Monad.Eff.Console.print n2')
examples/passing/FieldConsPuns.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−greet { greeting, name } = log $ greeting <> ", " <> name <> "."
7−
8−main = greet { greeting, name} where
9− greeting = "Hello"
10− name = "World"
examples/passing/FieldPuns.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−greet { greeting, name } = log $ greeting <> ", " <> name <> "."
7−
8−main = greet { greeting: "Hello", name: "World" }
examples/passing/FinalTagless.pursdeleted−22
@@ -1,22 +0,0 @@
1−module Main where
2−
3−import Prelude hiding (add)
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 = Control.Monad.Eff.Console.print $ runId three
examples/passing/FunctionScope.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Test.Assert
5−
6−mkValue :: Number -> Number
7−mkValue id = id
8−
9−main = do
10− let value = mkValue 1.0
11− assert $ value == 1.0
12− Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "Done"
examples/passing/Functions2.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Test.Assert
5−
6−test :: forall a b. a -> b -> a
7−test = \const _ -> const
8−
9−main = do
10− let value = test "Done" {}
11− assert' "Not done" $ value == "Done"
12− Control.Monad.Eff.Console.log "Done"
examples/passing/Guards.pursdeleted−29
@@ -1,29 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−collatz = \x -> case x of
6− y | y `mod` 2.0 == 0.0 -> y / 2.0
7− y -> y * 3.0 + 1.0
8−
9−-- Guards have access to current scope
10−collatz2 = \x y -> case x of
11− z | y > 0.0 -> z / 2.0
12− z -> z * 3.0 + 1.0
13−
14−min :: forall a. (Ord a) => a -> a -> a
15−min n m | n < m = n
16− | otherwise = m
17−
18−max :: forall a. (Ord a) => a -> a -> a
19−max n m = case unit of
20− _ | m < n -> n
21− | otherwise -> m
22−
23−testIndentation :: Number -> Number -> Number
24−testIndentation x y | x > 0.0
25− = x + y
26− | otherwise
27− = y - x
28−
29−main = Control.Monad.Eff.Console.log $ min "Done" "ZZZZ"
examples/passing/HoistError.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−import Test.Assert
7−
8−main = do
9− let x = 0.0
10− assert $ x == 0.0
11− let x = 1.0 + 1.0
12− log "Done"
examples/passing/IfThenElseMaybe.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Maybe a = Nothing | Just a
6−
7−test1 = if true then Just 10 else Nothing
8−
9−test2 = if true then Nothing else Just 10
10−
11−main = Control.Monad.Eff.Console.log "Done"
examples/passing/ImplicitEmptyImport.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−main = do
6− Control.Monad.Eff.Console.log "Hello"
7− Control.Monad.Eff.Console.log "Goodbye"
8− Control.Monad.Eff.Console.log "Done"
examples/passing/ImportHiding.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff.Console
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 = Control.Monad.Eff.Console.print $ test 0.0
examples/passing/InstanceBeforeClass.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−instance fooNumber :: Foo Number where
6− foo = 0.0
7−
8−class Foo a where
9− foo :: a
10−
11−main = Control.Monad.Eff.Console.log "Done"
examples/passing/IntAndChar.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Test.Assert
6−
7−f 1 = 1
8−f _ = 0
9−
10−g 'a' = 'a'
11−g _ = 'b'
12−
13−main = do
14− assert $ f 1 == 1
15− assert $ f 0 == 0
16− assert $ g 'a' == 'a'
17− assert $ g 'b' == 'b'
18− Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "Done"
examples/passing/KindedType.pursdeleted−33
@@ -1,33 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−type Star2Star f = f :: * -> *
6−
7−type Star t = t :: *
8−
9−test1 :: Star2Star Array String
10−test1 = ["test"]
11−
12−f :: Star (String -> String)
13−f s = s
14−
15−test2 = f "test"
16−
17−data Proxy (f :: * -> *) = Proxy
18−
19−test3 :: Proxy Array
20−test3 = Proxy
21−
22−type Test (f :: * -> *) = f String
23−
24−test4 :: Test Array
25−test4 = ["test"]
26−
27−class Clazz (a :: *) where
28− def :: a
29−
30−instance clazzString :: Clazz String where
31− def = "test"
32−
33−main = Control.Monad.Eff.Console.log "Done"
examples/passing/LargeSumType.pursdeleted−33
@@ -1,33 +0,0 @@
1−module Main where
2−
3−data Large = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
4−
5−explode A A = "A"
6−explode B B = "B"
7−explode C C = "C"
8−explode D D = "D"
9−explode E E = "E"
10−explode F F = "F"
11−explode G G = "G"
12−explode H H = "H"
13−explode I I = "I"
14−explode J J = "J"
15−explode K K = "K"
16−explode L L = "L"
17−explode M M = "M"
18−explode N N = "N"
19−explode O O = "O"
20−explode P P = "P"
21−explode Q Q = "Q"
22−explode R R = "R"
23−explode S S = "S"
24−explode T T = "T"
25−explode U U = "U"
26−explode V V = "V"
27−explode W W = "W"
28−explode X X = "X"
29−explode Y Y = "Y"
30−explode Z Z = "Z"
31−explode _ _ = ""
32−
33−main = Control.Monad.Eff.Console.log "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− Control.Monad.Eff.Console.print (test1 1.0)
48− Control.Monad.Eff.Console.print (test2 1.0 2.0)
49− Control.Monad.Eff.Console.print test3
50− Control.Monad.Eff.Console.print test4
51− Control.Monad.Eff.Console.print test5
52− Control.Monad.Eff.Console.print test7
53− Control.Monad.Eff.Console.print (test8 100.0)
examples/passing/Let2.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−test =
6− let f :: Number -> Boolean
7− f 0.0 = false
8− f n = g (n - 1.0)
9−
10− g :: Number -> Boolean
11− g 0.0 = true
12− g n = f (n - 1.0)
13−
14− x = f 1.0
15− in not x
16−
17−main = Control.Monad.Eff.Console.print test
examples/passing/LetInInstance.pursdeleted−14
@@ -1,14 +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 = go
10− where
11− go :: String -> String
12− go s = s
13−
14−main = Control.Monad.Eff.Console.log "Done"
examples/passing/LiberalTypeSynonyms.pursdeleted−21
@@ -1,21 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−type Reader = (->) String
6−
7−foo :: Reader String
8−foo s = s
9−
10−type AndFoo r = (foo :: String | r)
11−
12−getFoo :: forall r. Prim.Object (AndFoo r) -> String
13−getFoo o = o.foo
14−
15−type F r = { | r } -> { | r }
16−
17−f :: (forall r. F r) -> String
18−f g = case g { x: "Hello" } of
19− { x = x } -> x
20−
21−main = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "Done"
examples/passing/Match.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Foo a = Foo
6−
7−foo = \f -> case f of Foo -> "foo"
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/passing/ModuleExport.pursdeleted−9
@@ -1,9 +0,0 @@
1−module A (module Prelude) where
2− import Prelude
3−
4−module Main where
5− import Control.Monad.Eff.Console
6− import A
7−
8− main = do
9− print (show 1.0)
examples/passing/ModuleExportDupes.pursdeleted−19
@@ -1,19 +0,0 @@
1−module A (module Prelude) where
2− import Prelude
3−
4−module B (module Prelude) where
5− import Prelude
6−
7−module C (module Prelude, module A) where
8− import Prelude
9− import A
10−
11−module Main where
12− import Control.Monad.Eff.Console
13− import A
14− import B
15− import C
16− import Prelude
17−
18− main = do
19− print (show 1.0)
examples/passing/ModuleExportExcluded.pursdeleted−14
@@ -1,14 +0,0 @@
1−module A (module Prelude, foo) where
2− import Prelude
3−
4− foo :: Number -> Number
5− foo _ = 0.0
6−
7−module Main where
8− import Control.Monad.Eff.Console
9− import A (foo)
10−
11− otherwise = false
12−
13− main = do
14− print "1.0"
examples/passing/ModuleExportQualified.pursdeleted−9
@@ -1,9 +0,0 @@
1−module A (module Prelude) where
2− import Prelude
3−
4−module Main where
5− import Control.Monad.Eff.Console
6− import qualified A as B
7−
8− main = do
9− print (B.show 1.0)
examples/passing/ModuleExportSelf.pursdeleted−14
@@ -1,14 +0,0 @@
1−module A (module A, module Prelude) where
2− import Prelude
3−
4− type Foo = Boolean
5−
6−module Main where
7− import Control.Monad.Eff.Console
8− import A
9−
10− bar :: Foo
11− bar = true
12−
13− main = do
14− print (show bar)
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 = Control.Monad.Eff.Console.log "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− map = liftM1
17−
18−instance applyState :: Apply (State s) where
19− apply = 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− bind 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− Control.Monad.Eff.Console.log "Done"
48−
examples/passing/MultiArgFunctions.pursdeleted−27
@@ -1,27 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Data.Function
5−import Control.Monad.Eff
6−import Control.Monad.Eff.Console
7−
8−f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a
9−
10−g = mkFn2 $ \a b -> case {} of
11− _ | a <= 0.0 || b <= 0.0 -> b
12− _ -> runFn2 f (a - 0.0) (b - 0.0)
13−
14−main = do
15− runFn0 (mkFn0 $ \_ -> log $ show 0.0)
16− runFn1 (mkFn1 $ \a -> log $ show a) 0.0
17− runFn2 (mkFn2 $ \a b -> log $ show [a, b]) 0.0 0.0
18− runFn3 (mkFn3 $ \a b c -> log $ show [a, b, c]) 0.0 0.0 0.0
19− runFn4 (mkFn4 $ \a b c d -> log $ show [a, b, c, d]) 0.0 0.0 0.0 0.0
20− runFn5 (mkFn5 $ \a b c d e -> log $ show [a, b, c, d, e]) 0.0 0.0 0.0 0.0 0.0
21− runFn6 (mkFn6 $ \a b c d e f -> log $ show [a, b, c, d, e, f]) 0.0 0.0 0.0 0.0 0.0 0.0
22− runFn7 (mkFn7 $ \a b c d e f g -> log $ show [a, b, c, d, e, f, g]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0
23− runFn8 (mkFn8 $ \a b c d e f g h -> log $ 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
24− runFn9 (mkFn9 $ \a b c d e f g h i -> log $ 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
25− runFn10 (mkFn10 $ \a b c d e f g h i j-> log $ 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
26− print $ runFn2 g 0.0 0.0
27− log "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 = Control.Monad.Eff.Console.log "Done"
examples/passing/MutRec2.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data A = A B
6−
7−data B = B A
8−
9−foreign import data S :: *
10−
11−f :: A -> S
12−f a = case a of A b -> g b
13−
14−g b = case b of B a -> f a
15−
16−showN :: A -> S
17−showN a = f a
18−
19−main = Control.Monad.Eff.Console.log "Done"
examples/passing/MutRec3.pursdeleted−19
@@ -1,19 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data A = A B
6−
7−data B = B A
8−
9−foreign import data S :: *
10−
11−f a = case a of A b -> g b
12−
13−g :: B -> S
14−g b = case b of B a -> f a
15−
16−showN :: A -> S
17−showN a = f a
18−
19−main = Control.Monad.Eff.Console.log "Done"
examples/passing/NakedConstraint.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff.Console
4−
5−data List a = Nil | Cons a (List a)
6−
7−head :: (Partial) => List Int -> Int
8−head (Cons x _) = x
9−
10−main = log "Done"
examples/passing/NamedPatterns.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−foo = \x -> case x of
6− y@{ foo = "Foo" } -> y
7− y -> y
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/passing/NegativeBinder.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−test :: Number -> Boolean
6−test -1.0 = false
7−test _ = true
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/passing/NegativeIntInRange.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−n :: Int
6−n = -2147483648
7−
8−main = Control.Monad.Eff.Console.log "Done"
examples/passing/Nested.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Extend r a = Extend { prev :: r a, next :: a }
6−
7−data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)
8−
9−main = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.print (fn "Done")
examples/passing/NestedWhere.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−f x = g x
6− where
7− g x = go x
8− where
9− go x = go1 (x - 1.0)
10− go1 x = go x
11−
12−main = Control.Monad.Eff.Console.log "Done"
examples/passing/Newtype.pursdeleted−23
@@ -1,23 +0,0 @@
1−module Main where
2−
3−import Prelude hiding (apply)
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−
7−newtype Thing = Thing String
8−
9−instance showThing :: Show Thing where
10− show (Thing x) = "Thing " ++ show x
11−
12−newtype Box a = Box a
13−
14−instance showBox :: (Show a) => Show (Box a) where
15− show (Box x) = "Box " ++ show x
16−
17−apply f x = f x
18−
19−main = do
20− print $ Thing "hello"
21− print $ Box 42.0
22− print $ apply Box 9000.0
23− log "Done"
examples/passing/NewtypeEff.pursdeleted−29
@@ -1,29 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−import Control.Monad.Eff
6−
7−newtype T a = T (Eff (console :: CONSOLE) a)
8−
9−runT :: forall a. T a -> Eff (console :: CONSOLE) a
10−runT (T t) = t
11−
12−instance functorT :: Functor T where
13− map f (T t) = T (f <$> t)
14−
15−instance applyT :: Apply T where
16− apply (T f) (T x) = T (f <*> x)
17−
18−instance applicativeT :: Applicative T where
19− pure t = T (pure t)
20−
21−instance bindT :: Bind T where
22− bind (T t) f = T (t >>= \x -> runT (f x))
23−
24−instance monadT :: Monad T
25−
26−main = runT do
27− T $ log "Done"
28− T $ log "Done"
29− T $ log "Done"
examples/passing/NewtypeWithRecordUpdate.pursdeleted−16
@@ -1,16 +0,0 @@
1−-- https://github.com/purescript/purescript/issues/812.0
2−
3−module Main where
4−
5−import Prelude
6−import Control.Monad.Eff.Console
7−
8−newtype NewType a = NewType (Object a)
9−
10−rec1 :: Object (a :: Number, b :: Number, c:: Number)
11−rec1 = { a: 0.0, b: 0.0, c: 0.0 }
12−
13−rec2 :: NewType (a :: Number, b :: Number, c :: Number)
14−rec2 = NewType (rec1 { a = 1.0 })
15−
16−main = log "Done"
examples/passing/NonConflictingExports.pursdeleted−14
@@ -1,14 +0,0 @@
1−module A where
2−
3− thing :: Int
4− thing = 1
5−
6−-- No failure here as the export `thing` only refers to Main.thing
7−module Main (thing, main) where
8−
9− import A
10−
11− thing :: Int
12− thing = 2
13−
14− main = Control.Monad.Eff.Console.log "Done"
examples/passing/ObjectGetter.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−getX = _.x
6−
7−point = { x: 1.0, y: 0.0 }
8−
9−main = do
10− Control.Monad.Eff.Console.print $ getX point
11− Control.Monad.Eff.Console.log $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }
12− Control.Monad.Eff.Console.log $ (_.x >>> _.y) { x: { y: "Nested" } }
13− Control.Monad.Eff.Console.log $ _.value { value: "Done!" }
examples/passing/ObjectSynonym.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−type Inner = Number
6−
7−inner :: Inner
8−inner = 0.0
9−
10−type Outer = { inner :: Inner }
11−
12−outer :: Outer
13−outer = { inner: inner }
14−
15−main = Control.Monad.Eff.Console.log "Done"
examples/passing/ObjectUpdate.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−update1 = \o -> o { foo = "Foo" }
6−
7−update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
8−update2 = \o -> o { foo = "Foo" }
9−
10−replace = \o -> case o of
11− { foo = "Foo" } -> o { foo = "Bar" }
12− { foo = "Bar" } -> o { bar = "Baz" }
13− o -> o
14−
15−polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
16−polyUpdate = \o -> o { foo = "Foo" }
17−
18−inferPolyUpdate = \o -> o { foo = "Foo" }
19−
20−main = Control.Monad.Eff.Console.log ((update1 {foo: ""}).foo)
examples/passing/ObjectUpdate2.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−type X r = { | r }
6−
7−x :: X (baz :: String)
8−x = { baz: "baz" }
9−
10−blah :: forall r. X r -> X r
11−blah x = x
12−
13−test = blah x
14− { baz = "blah"
15− }
16−
17−main = Control.Monad.Eff.Console.log "Done"
examples/passing/ObjectUpdater.pursdeleted−24
@@ -1,24 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−import Test.Assert
7−
8−getValue :: forall e. Eff (| e) Boolean
9−getValue = return true
10−
11−main = do
12− let record = { value: false }
13− record' <- record { value = _ } <$> getValue
14− assert $ record'.value == true
15−
16− let point = { x: 1.0, y: 1.0 }
17− x = 10.0
18− point' = (point { x = _, y = x }) 100.0
19−
20− assert $ point'.x == 100.0
21− assert $ point'.y == 10.0
22−
23− let record2 = (_ { x = _ }) { x: 0.0 } 10.0
24− assert $ record2.x == 10.0
examples/passing/ObjectWildcards.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−import Test.Assert
7−
8−mkRecord = { foo: _, bar: _, baz: "baz" }
9−
10−getValue :: forall e. Eff (| e) Boolean
11−getValue = return true
12−
13−main = do
14− obj <- { value: _ } <$> getValue
15− print obj.value
16− let x = 1.0
17− point <- { x: _, y: x } <$> return 2.0
18− assert $ point.x == 2.0
19− assert $ point.y == 1.0
20− log (mkRecord 1.0 "Done!").bar
examples/passing/Objects.pursdeleted−35
@@ -1,35 +0,0 @@
1−module Main where
2−
3−import Prelude hiding (append)
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 = Control.Monad.Eff.Console.log "Done"
examples/passing/OneConstructor.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data One a = One a
6−
7−one' (One a) = a
8−
9−main = Control.Monad.Eff.Console.log "Done"
examples/passing/OperatorAlias.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−infixl 4 what as ?!
7−
8−what :: forall a b. a -> b -> a
9−what a _ = a
10−
11−main = log $ "Done" ?! true
examples/passing/OperatorAliasElsewhere.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Def where
2−
3−what :: forall a b. a -> b -> a
4−what a _ = a
5−
6−module Main where
7−
8−import Prelude
9−import Def (what)
10−import Control.Monad.Eff.Console
11−
12−infixl 4 what as ?!
13−
14−main = log $ "Done" ?! true
examples/passing/OperatorAssociativity.pursdeleted−25
@@ -1,25 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−import Test.Assert
7−
8−bug :: Number -> Number -> Number
9−bug a b = 0.0 - (a - b)
10−
11−main = do
12− assert (bug 0.0 2.0 == 2.0)
13− assert (0.0 - (0.0 - 2.0) == 2.0)
14− assert (0.0 - (0.0 + 2.0) == -2.0)
15− assert (6.0 / (3.0 * 2.0) == 1.0)
16− assert ((6.0 / 3.0) * 2.0 == 4.0)
17− assert (not (1.0 < 0.0) == true)
18− assert (not ((negate 1.0) < 0.0) == false)
19− assert (negate (1.0 + 10.0) == -11.0)
20− assert (2.0 * 3.0 / 4.0 == 1.5)
21− assert (1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0)
22− assert (1.0 + 10.0 - 5.0 == 6.0)
23− assert (1.0 + 10.0 * 5.0 == 51.0)
24− assert (10.0 * 5.0 - 1.0 == 49.0)
25− log "Success!"
examples/passing/OperatorInlining.pursdeleted−47
@@ -1,47 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−main = do
7−
8− -- semiringNumber
9− print (1.0 + 2.0)
10− print (1.0 * 2.0)
11−
12− -- ringNumber
13− print (1.0 - 2.0)
14− print (negate 1.0)
15−
16− -- moduleSemiringNumber
17− print (1.0 / 2.0)
18−
19− -- ordNumber
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− print (1.0 == 2.0)
25−
26− -- eqNumber
27− print (1.0 == 2.0)
28− print (1.0 /= 2.0)
29−
30− -- eqString
31− print ("foo" == "bar")
32− print ("foo" /= "bar")
33−
34− -- eqBoolean
35− print (true == false)
36− print (true /= false)
37−
38− -- semigroupString
39− print ("foo" ++ "bar")
40− print ("foo" <> "bar")
41−
42− -- latticeBoolean
43− print (top && true)
44− print (bottom || false)
45−
46− -- complementedLatticeBoolean
47− print (not true)
examples/passing/OperatorSections.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Test.Assert
5−
6−main = do
7− assert $ (/ 2.0) 4.0 == 2.0
8− assert $ (2.0 /) 4.0 == 0.5
9− assert $ (`const` 1.0) 2.0 == 2.0
10− assert $ (1.0 `const`) 2.0 == 1.0
11− let foo = { x: 2.0 }
12− assert $ (/ foo.x) 4.0 == 2.0
13− assert $ (foo.x /) 4.0 == 0.5
14− let (//) x y = x.x / y.x
15− assert $ (// foo { x = 4.0 }) { x: 4.0 } == 1.0
16− assert $ (foo { x = 4.0 } //) { x: 4.0 } == 1.0
17− Control.Monad.Eff.Console.log "Done!"
examples/passing/Operators.pursdeleted−99
@@ -1,99 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−
7−(?!) :: forall a. a -> a -> a
8−(?!) x _ = x
9−
10−bar :: String -> String -> String
11−bar = \s1 s2 -> s1 ++ s2
12−
13−test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n
14−test1 x y z = x * y + z x y
15−
16−test2 = (\x -> x.foo false) { foo : \_ -> 1.0 }
17−
18−test3 = (\x y -> x)(1.0 + 2.0 * (1.0 + 2.0)) (true && (false || false))
19−
20−k = \x -> \y -> x
21−
22−test4 = 1 `k` 2
23−
24−infixl 5 %%
25−
26−(%%) :: Number -> Number -> Number
27−(%%) x y = x * y + y
28−
29−test5 = 1.0 %% 2.0 %% 3.0
30−
31−test6 = ((\x -> x) `k` 2.0) 3.0
32−
33−(<+>) :: String -> String -> String
34−(<+>) = \s1 s2 -> s1 ++ s2
35−
36−test7 = "Hello" <+> "World!"
37−
38−(@@) :: forall a b. (a -> b) -> a -> b
39−(@@) = \f x -> f x
40−
41−foo :: String -> String
42−foo = \s -> s
43−
44−test8 = foo @@ "Hello World"
45−
46−test9 = Main.foo @@ "Hello World"
47−
48−test10 = "Hello" `Main.bar` "World"
49−
50−(...) :: forall a. Array a -> Array a -> Array a
51−(...) = \as -> \bs -> as
52−
53−test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]
54−
55−test12 (<%>) a b = a <%> b
56−
57−test13 = \(<%>) a b -> a <%> b
58−
59−test14 :: Number -> Number -> Boolean
60−test14 a b = a < b
61−
62−test15 :: Number -> Number -> Boolean
63−test15 a b = const false $ a `test14` b
64−
65−test17 :: Number
66−test17 = negate (-1.0)
67−
68−test18 :: Number
69−test18 = negate $ negate 1.0
70−
71−test19 :: Number
72−test19 = negate $ negate (-1.0)
73−
74−test20 :: Number
75−test20 = 1.0 @ 2.0
76− where
77− (@) x y = x + y * y
78−
79−main = do
80− let t1 = test1 1.0 2.0 (\x y -> x + y)
81− let t2 = test2
82− let t3 = test3
83− let t4 = test4
84− let t5 = test5
85− let t6 = test6
86− let t7 = test7
87− let t8 = test8
88− let t9 = test9
89− let t10 = test10
90− let t11 = test11
91− let t12 = test12 k 1.0 2.0
92− let t13 = test13 k 1.0 2.0
93− let t14 = test14 1.0 2.0
94− let t15 = test15 1.0 2.0
95− let t17 = test17
96− let t18 = test18
97− let t19 = test19
98− let t20 = test20
99− log "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 = Control.Monad.Eff.Console.log "Done"
examples/passing/OptionalQualified.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−-- qualified import with the "qualified" keyword
4−import qualified Prelude as P
5−
6−-- qualified import without the "qualified" keyword
7−import Control.Monad.Eff.Console as Console
8−
9−bind = P.bind
10−
11−main = do
12− message <- P.return "success!"
13− Console.log message
examples/passing/OverlappingInstances.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data A = A
6−
7−instance showA1 :: Show A where
8− show A = "Instance 1"
9−
10−instance showA2 :: Show A where
11− show A = "Instance 2"
12−
13−main = Test.Assert.assert $ show A == "Instance 1"
examples/passing/OverlappingInstances2.pursdeleted−23
@@ -1,23 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data A = A | B
6−
7−instance eqA1 :: Eq A where
8− eq A A = true
9− eq B B = true
10− eq _ _ = false
11−
12−instance eqA2 :: Eq A where
13− eq _ _ = true
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 = Test.Assert.assert $ test A B == "false"
examples/passing/OverlappingInstances3.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class Foo a
6−
7−instance foo1 :: Foo Number
8−
9−instance foo2 :: Foo Number
10−
11−test :: forall a. (Foo a) => a -> a
12−test a = a
13−
14−test1 = test 0.0
15−
16−main = Test.Assert.assert (test1 == 0.0)
examples/passing/PartialFunction.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Test.Assert
5−
6−fn :: Number -> Number
7−fn 0.0 = 0.0
8−fn 1.0 = 2.0
9−
10−main = assertThrows $ \_ -> 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 = Control.Monad.Eff.Console.log "Done"
examples/passing/PendingConflictingImports.pursdeleted−17
@@ -1,17 +0,0 @@
1−module A where
2−
3− thing :: Int
4− thing = 1
5−
6−module B where
7−
8− thing :: Int
9− thing = 2
10−
11−module Main where
12−
13− -- No error as we never force `thing` to be resolved in `Main`
14− import A
15− import B
16−
17− main = Control.Monad.Eff.Console.log "Done"
examples/passing/PendingConflictingImports2.pursdeleted−14
@@ -1,14 +0,0 @@
1−module A where
2−
3− thing :: Int
4− thing = 1
5−
6−module Main where
7−
8− import A
9−
10− -- No error as we never force `thing` to be resolved in `Main`
11− thing :: Int
12− thing = 2
13−
14− main = Control.Monad.Eff.Console.log "Done"
examples/passing/Person.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Person = Person { name :: String, age :: Number }
6−
7−showPerson :: Person -> String
8−showPerson = \p -> case p of
9− Person o -> o.name ++ ", aged " ++ show o.age
10−
11−main = Control.Monad.Eff.Console.log "Done"
examples/passing/QualifiedQualifiedImports.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−-- qualified import with qualified imported names
4−import qualified Control.Monad.Eff.Console (log) as Console
5−
6−main = Console.log "Success!"
examples/passing/Rank2Data.pursdeleted−29
@@ -1,29 +0,0 @@
1−module Main where
2−
3−import Prelude hiding (add)
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 = Control.Monad.Eff.Console.log "Done'"
examples/passing/Rank2Object.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−data Foo = Foo { id :: forall a. a -> a }
7−
8−foo :: Foo -> Number
9−foo (Foo { id = f }) = f 0.0
10−
11−main = log "Done"
examples/passing/Rank2TypeSynonym.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−
6−type Foo a = forall f. (Monad f) => f a
7−
8−foo :: forall a. a -> Foo a
9−foo x = pure x
10−
11−bar :: Foo Number
12−bar = foo 3.0
13−
14−main = do
15− x <- bar
16− Control.Monad.Eff.Console.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 = Control.Monad.Eff.Console.log "Done"
examples/passing/ReExportQualified.pursdeleted−16
@@ -1,16 +0,0 @@
1−module A where
2− x = "Do"
3−
4−module B where
5− y = "ne"
6−
7−module C (module A, module M2) where
8− import A
9− import qualified B as M2
10−
11−module Main where
12−
13− import Prelude
14− import C
15−
16− main = Control.Monad.Eff.Console.log (x ++ y)
examples/passing/RebindableSyntax.pursdeleted−39
@@ -1,39 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−example1 :: String
6−example1 = do
7− "Do"
8− " notation"
9− " for"
10− " Semigroup"
11− where
12− bind x f = x <> f unit
13−
14−(*>) :: forall f a b. (Apply f) => f a -> f b -> f b
15−(*>) fa fb = const id <$> fa <*> fb
16−
17−newtype Const a b = Const a
18−
19−runConst :: forall a b. Const a b -> a
20−runConst (Const a) = a
21−
22−instance functorConst :: Functor (Const a) where
23− map _ (Const a) = Const a
24−
25−instance applyConst :: (Semigroup a) => Apply (Const a) where
26− apply (Const a1) (Const a2) = Const (a1 <> a2)
27−
28−example2 :: Const String Unit
29−example2 = do
30− Const "Do"
31− Const " notation"
32− Const " for"
33− Const " Apply"
34− where
35− bind x f = x *> f unit
36−
37−main = do
38− Control.Monad.Eff.Console.log example1
39− Control.Monad.Eff.Console.log $ 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 = Control.Monad.Eff.Console.log "Done"
examples/passing/ReservedWords.pursdeleted−15
@@ -1,15 +0,0 @@
1−-- See https://github.com/purescript/purescript/issues/606
2−module Main where
3−
4−import Prelude
5−
6−o :: { type :: String }
7−o = { type: "o" }
8−
9−p :: { type :: String }
10−p = o { type = "p" }
11−
12−f :: forall r. { type :: String | r } -> String
13−f { type = "p" } = "Done"
14−
15−main = Control.Monad.Eff.Console.log $ f { type: p.type, foo: "bar" }
examples/passing/RowConstructors.pursdeleted−42
@@ -1,42 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−type Foo = (x :: Number | (y :: Number | (z :: Number)))
6−type Bar = (x :: Number, y :: Number, z :: Number)
7−type Baz = { w :: Number | Bar }
8−
9−foo :: { | Foo }
10−foo = { x: 0.0, y: 0.0, z: 0.0 }
11−
12−bar :: { | Bar }
13−bar = { x: 0.0, y: 0.0, z: 0.0 }
14−
15−id' :: Object Foo -> Object Bar
16−id' = id
17−
18−foo' :: { | Foo }
19−foo' = id' foo
20−
21−bar' :: { | Bar }
22−bar' = id' bar
23−
24−baz :: Baz
25−baz = { x: 0.0, y: 0.0, z: 0.0, w: 0.0 }
26−
27−type Quux r = (q :: Number | r)
28−type Norf r = (q' :: Number | Quux r)
29−
30−quux :: { f :: { | Foo } | Quux Bar }
31−quux = { f: foo', x: 0.0, y: 0.0, z: 0.0, q: 0.0 }
32−
33−quux' :: { | Norf Bar }
34−quux' = { x: 0.0, y: 0.0, z: 0.0, q: 0.0, q': 0.0 }
35−
36−wildcard :: { w :: Number | _ } -> Baz
37−wildcard { w: w } = { x: w, y: w, z: w, w: w }
38−
39−wildcard' :: { | Quux _ } -> Number
40−wildcard' { q: q } = q
41−
42−main = Control.Monad.Eff.Console.log "Done"
examples/passing/RowPolyInstanceContext.pursdeleted−22
@@ -1,22 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class T s m where
6− state :: (s -> s) -> m Unit
7−
8−data S s a = S (s -> { new :: s, ret :: a })
9−
10−instance st :: T s (S s) where
11− state f = S $ \s -> { new: f s, ret: unit }
12−
13−test1 :: forall r . S { foo :: String | r } Unit
14−test1 = state $ \o -> o { foo = o.foo ++ "!" }
15−
16−test2 :: forall m r . (T { foo :: String | r } m) => m Unit
17−test2 = state $ \o -> o { foo = o.foo ++ "!" }
18−
19−main = do
20− let t1 = test1
21− let t2 = test2
22− Control.Monad.Eff.Console.log "Done"
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 = Control.Monad.Eff.Console.print $ a 10.0
examples/passing/ScopedTypeVariables.pursdeleted−36
@@ -1,36 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−test1 :: forall a. (a -> a) -> a -> a
6−test1 f x = g (g x)
7− where
8− g :: a -> a
9− g y = f (f y)
10−
11−test2 :: forall a. (a -> a) -> a -> a
12−test2 = h
13− where
14− h :: forall b. (b -> b) -> b -> b
15− h f x = g (g x)
16− where
17− g :: b -> b
18− g y = f (f y)
19−
20−test3 :: Number
21−test3 = ((\b -> b :: b) :: forall b. b -> b) 0.0
22−
23−test4 :: forall a. (a -> a) -> a -> a
24−test4 = h
25− where
26− h :: forall b. (b -> b) -> b -> b
27− h f x = g (g x)
28− where
29− g :: b -> b
30− g y = j (f (f y))
31− where
32− j :: forall b. b -> b
33− j x = x
34−
35−
36−main = Control.Monad.Eff.Console.log "Done"
examples/passing/Sequence.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−
6−data List a = Cons a (List a) | Nil
7−
8−class Sequence t where
9− sequence :: forall m a. (Monad m) => t (m a) -> m (t a)
10−
11−instance sequenceList :: Sequence List where
12− sequence Nil = pure Nil
13− sequence (Cons x xs) = Cons <$> x <*> sequence xs
14−
15−main = sequence $ Cons (Control.Monad.Eff.Console.log "Done") Nil
examples/passing/SequenceDesugared.pursdeleted−37
@@ -1,37 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−
6−data List a = Cons a (List a) | Nil
7−
8−data Sequence t = Sequence (forall m a. (Monad m) => t (m a) -> m (t a))
9−
10−sequence :: forall t. Sequence t -> (forall m a. (Monad m) => t (m a) -> m (t a))
11−sequence (Sequence s) = s
12−
13−sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a)
14−sequenceListSeq Nil = pure Nil
15−sequenceListSeq (Cons x xs) = Cons <$> x <*> sequenceListSeq xs
16−
17−sequenceList :: Sequence List
18−sequenceList = Sequence (sequenceListSeq)
19−
20−sequenceList' :: Sequence List
21−sequenceList' = Sequence ((\val -> case val of
22− Nil -> pure Nil
23− Cons x xs -> Cons <$> x <*> sequence sequenceList' xs))
24−
25−sequenceList'' :: Sequence List
26−sequenceList'' = Sequence (sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a))
27−
28−sequenceList''' :: Sequence List
29−sequenceList''' = Sequence ((\val -> case val of
30− Nil -> pure Nil
31− Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))
32−
33−main = do
34− sequence sequenceList $ Cons (Control.Monad.Eff.Console.log "Done") Nil
35− sequence sequenceList' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
36− sequence sequenceList'' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
37− sequence sequenceList''' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
examples/passing/ShadowedModuleName.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Test where
2−
3− data Z = Z String
4−
5− runZ :: Z -> String
6− runZ (Z s) = s
7−
8−module Main where
9−
10− import Test
11− import Control.Monad.Eff.Console
12−
13− data Test = Test
14−
15− main = log (runZ (Z "done"))
examples/passing/ShadowedRename.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.Eff.Console
6−import Test.Assert
7−
8−foo foo = let foo_1 = \_ -> foo
9− foo_2 = foo_1 unit + 1.0
10− in foo_2
11−
12−main = do
13− assert $ foo 1.0 == 2.0
14− log "Done"
examples/passing/ShadowedTCO.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Prelude hiding (add)
4−
5−runNat f = f 0.0 (\n -> n + 1.0)
6−
7−zero' z _ = z
8−
9−succ f zero' succ = succ (f zero' succ)
10−
11−add f g zero' succ = g (f zero' succ) succ
12−
13−one' = succ zero'
14−two = succ one'
15−four = add two two
16−fourNumber = runNat four
17−
18−main = Control.Monad.Eff.Console.log $ show fourNumber
examples/passing/ShadowedTCOLet.pursdeleted−9
@@ -1,9 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−f x y z =
6− let f 1.0 2.0 3.0 = 1.0
7− in f x z y
8−
9−main = Control.Monad.Eff.Console.log $ show $ f 1.0 3.0 2.0
examples/passing/SignedNumericLiterals.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−p = 0.5
6−q = 1.0
7−x = -1.0
8−y = -0.5
9−z = 0.5
10−w = 1.0
11−
12−f :: Number -> Number
13−f x = -x
14−
15−test1 = 2.0 - 1.0
16−
17−main = Control.Monad.Eff.Console.log "Done"
examples/passing/StringEscapes.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude ((==), bind)
4−import Test.Assert (assert)
5−
6−singleCharacter = "\0\b\t\n\v\f\r\"\\" == "\x0\x8\x9\xA\xB\xC\xD\x22\x5C"
7−hex = "\x1D306\x2603\x3C6\xE0\x0" == "𝌆☃φà\0"
8−decimal = "\119558\9731\966\224\0" == "𝌆☃φà\0"
9−surrogatePair = "\xD834\xDF06" == "\x1D306"
10−
11−main = do
12− assert singleCharacter
13− assert hex
14− assert decimal
15− assert surrogatePair
examples/passing/Superclasses1.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class Su a where
6− su :: a -> a
7−
8−class (Su 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 clNumber :: Cl Number where
15− cl n m = n + m
16−
17−test :: forall a. (Cl a) => a -> a
18−test a = su (cl a a)
19−
20−main = Control.Monad.Eff.Console.print $ test 10.0
examples/passing/Superclasses3.pursdeleted−41
@@ -1,41 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
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 (console :: CONSOLE) a)
20−
21−runMTrace :: forall a. MTrace a -> Eff (console :: CONSOLE) a
22−runMTrace (MTrace a) = a
23−
24−instance functorMTrace :: Functor MTrace where
25− map = liftM1
26−
27−instance applyMTrace :: Apply MTrace where
28− apply = ap
29−
30−instance applicativeMTrace :: Applicative MTrace where
31− pure = MTrace <<< return
32−
33−instance bindMTrace :: Bind MTrace where
34− bind 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 (log s)
40−
41−main = runMTrace $ test "Done"
examples/passing/TCOCase.pursdeleted−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Data = One | More Data
6−
7−main = Control.Monad.Eff.Console.log (from (to 10000.0 One))
8− where
9− to 0.0 a = a
10− to n a = to (n - 1.0) (More a)
11− from One = "Done"
12− 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 = Control.Monad.Eff.Console.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))
examples/passing/Tick.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−test' x = x
6−
7−main = Control.Monad.Eff.Console.log "Done"
examples/passing/TopLevelCase.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−gcd :: Number -> Number -> Number
6−gcd 0.0 x = x
7−gcd x 0.0 = x
8−gcd x y | x > y = gcd (x `mod` y) y
9−gcd x y = gcd (y `mod` x) x
10−
11−guardsTest [x] | x > 0.0 = []
12−guardsTest xs = xs
13−
14−data A = A
15−
16−parseTest A 0.0 = 0.0
17−
18−main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeClassMemberOrderChange.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class Test a where
6− fn :: a -> a -> a
7− val :: a
8−
9−instance testBoolean :: Test Boolean where
10− val = true
11− fn x y = y
12−
13−main = Control.Monad.Eff.Console.log (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− map = liftM1
26−
27−instance applyData :: Apply Data where
28− apply = ap
29−
30−instance applicativeData :: Applicative Data where
31− pure = Data
32−
33−instance bindData :: Bind Data where
34− bind (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− map = liftM1
42−
43−instance applyMaybe :: Apply Maybe where
44− apply = ap
45−
46−instance applicativeMaybe :: Applicative Maybe where
47− pure = Just
48−
49−instance bindMaybe :: Bind Maybe where
50− bind Nothing _ = Nothing
51− bind (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 = Control.Monad.Eff.Console.log (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 = Control.Monad.Eff.Console.log $ 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− map _ (Left x) = Left x
9− map f (Right y) = Right (f y)
10−
11−main = Control.Monad.Eff.Console.log "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 = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeSynonymInData.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−type A a = Array a
6−
7−data Foo a = Foo (A a) | Bar
8−
9−foo (Foo []) = Bar
10−
11−main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeSynonyms.pursdeleted−27
@@ -1,27 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−type Lens a b =
6− { get :: a -> b
7− , set :: a -> b -> a
8− }
9−
10−composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c
11−composeLenses = \l1 -> \l2 ->
12− { get: \a -> l2.get (l1.get a)
13− , set: \a c -> l1.set a (l2.set (l1.get a) c)
14− }
15−
16−type Pair a b = { fst :: a, snd :: b }
17−
18−fst :: forall a b. Lens (Pair a b) a
19−fst =
20− { get: \p -> p.fst
21− , set: \p a -> { fst: a, snd: p.snd }
22− }
23−
24−test1 :: forall a b c. Lens (Pair (Pair a b) c) a
25−test1 = composeLenses fst fst
26−
27−main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeWildcards.pursdeleted−15
@@ -1,15 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−testTopLevel :: _ -> _
6−testTopLevel n = n + 1.0
7−
8−test :: forall a. (Eq a) => (a -> a) -> a -> a
9−test f a = go (f a) a
10− where
11− go :: _ -> _ -> _
12− go a1 a2 | a1 == a2 = a1
13− go a1 _ = go (f a1) a1
14−
15−main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeWildcardsRecordExtension.pursdeleted−8
@@ -1,8 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−foo :: forall a. {b :: Number | a} -> {b :: Number | _}
6−foo f = f
7−
8−main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeWithoutParens.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Lib (X, Y) where
2−
3− data X = X
4− type Y = X
5−
6−module Main where
7−
8− import Lib (X, Y)
9−
10− idX :: X -> X
11− idX x = x
12−
13− idY :: Y -> Y
14− idY y = y
15−
16− main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypedBinders.pursdeleted−67
@@ -1,67 +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− map = liftM1
17−
18−instance applyState :: Apply (State s) where
19− apply = 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− bind 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− str :: String <- get
44− return str
45−
46−test2 :: (Int -> Int) -> Int
47−test2 = (\(f :: Int -> Int) -> f 10)
48−
49−test3 :: Int -> Boolean
50−test3 n = case n of
51− (0 :: Int) -> true
52− _ -> false
53−
54−test4 :: Tuple Int Int -> Tuple Int Int
55−test4 = (\(Tuple a b :: Tuple Int Int) -> Tuple b a)
56−
57−type Int1 = Int
58−
59−test5 :: Int1 -> Int1
60−test5 = \(x :: Int1) -> x
61−
62−main = do
63− let t1 = test
64− t2 = test2 id
65− t3 = test3 1
66− t4 = test4 (Tuple 1 0)
67− Control.Monad.Eff.Console.log "Done"
examples/passing/TypedWhere.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data E a b = L a | R b
6−
7−data L a = C a (L a) | N
8−
9−lefts :: forall a b. L (E a b) -> L a
10−lefts = go N
11− where
12− go :: forall a b. L a -> L (E a b) -> L a
13− go ls N = ls
14− go ls (C (L a) rest) = go (C a ls) rest
15− go ls (C _ rest) = go ls rest
16−
17−main = Control.Monad.Eff.Console.log "Done"
examples/passing/UTF8Sourcefile.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff.Console
4−
5−-- '→' is multibyte sequence \u2192.
6−utf8multibyte = "Hello λ→ world!!"
7−
8−main = do
9− log "done"
10−
examples/passing/UnderscoreIdent.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−data Data_type = Con_Structor | Con_2 String
6−
7−type Type_name = Data_type
8−
9−done (Con_2 s) = s
10−
11−main = Control.Monad.Eff.Console.log (done (Con_2 "Done"))
examples/passing/UnicodeIdentifier.pursdeleted−5
@@ -1,5 +0,0 @@
1−module Main where
2−
3−f asgård = asgård
4−
5−main = Control.Monad.Eff.Console.log (f "Done")
examples/passing/UnicodeOperators.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−compose :: forall a b c. (b -> c) -> (a -> b) -> a -> c
4−compose f g a = f (g a)
5−
6−infixr 9 compose as ∘
7−
8−test1 = (\x -> x) ∘ \y -> y
9−
10−elem :: forall a b. a -> (a -> Boolean) -> Boolean
11−elem x f = f x
12−
13−infixl 1 elem as ∈
14−
15−emptySet :: forall a. a -> Boolean
16−emptySet _ = true
17−
18−test2 = 1 ∈ emptySet
19−
20−main = Control.Monad.Eff.Console.log "Done"
examples/passing/Unit.pursdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−main = print (const unit $ "Hello world")
examples/passing/UnknownInTypeClassLookup.pursdeleted−14
@@ -1,14 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−class EQ a b
6−
7−instance eqAA :: EQ a a
8−
9−test :: forall a b. (EQ a b) => a -> b -> String
10−test _ _ = "Done"
11−
12−runTest a = test a a
13−
14−main = Control.Monad.Eff.Console.log $ runTest 0.0
examples/passing/UntupledConstraints.pursdeleted−17
@@ -1,17 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff.Console
5−
6−class Show a <= Nonsense a where
7− method :: a -> a
8−
9−data Box a = Box a
10−
11−instance showBox :: Show a => Show (Box a) where
12− show (Box a) = "Box " <> show a
13−
14−strangeThing :: forall m. Semigroup (m Unit) => m Unit -> m Unit -> m Unit
15−strangeThing x y = x <> y
16−
17−main = log "Done"
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− Control.Monad.Eff.Console.print (test1 1.0)
44− Control.Monad.Eff.Console.print (test2 1.0 2.0)
45− Control.Monad.Eff.Console.print test3
46− Control.Monad.Eff.Console.print test4
47− Control.Monad.Eff.Console.print test5
48− Control.Monad.Eff.Console.print test6
49− Control.Monad.Eff.Console.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 = Control.Monad.Eff.Console.log "Done"
examples/passing/s.pursdeleted−7
@@ -1,7 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−s = \x y z -> x z (y z)
6−
7−main = Control.Monad.Eff.Console.log "Done"
hierarchy/Main.hsdeleted−115
@@ -1,115 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Hardy Jones 2014
5−-- License : MIT (http://opensource.org/licenses/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−{-# LANGUAGE TupleSections #-}
17−{-# LANGUAGE DataKinds #-}
18−
19−module Main where
20−
21−import Control.Monad (unless)
22−
23−import Data.List (intercalate,nub,sort)
24−import Data.Foldable (for_)
25−import Data.Version (showVersion)
26−
27−import Options.Applicative
28−import System.Directory (createDirectoryIfMissing)
29−import System.FilePath ((</>))
30−import System.FilePath.Glob (glob)
31−import System.Exit (exitFailure, exitSuccess)
32−import System.IO (hPutStr, stderr)
33−
34−import qualified Language.PureScript as P
35−import qualified Paths_purescript as Paths
36−
37−data HierarchyOptions = HierarchyOptions
38− { hierachyInput :: FilePath
39− , hierarchyOutput :: Maybe FilePath
40− }
41−
42−newtype SuperMap = SuperMap { unSuperMap :: Either (P.ProperName 'P.ClassName) ((P.ProperName 'P.ClassName), (P.ProperName 'P.ClassName)) }
43− deriving Eq
44−
45−instance Show SuperMap where
46− show (SuperMap (Left sub)) = show sub
47− show (SuperMap (Right (super, sub))) = show super ++ " -> " ++ show sub
48−
49−instance Ord SuperMap where
50− compare (SuperMap s) (SuperMap s') = getCls s `compare` getCls s'
51− where
52− getCls = either id snd
53−
54−runModuleName :: P.ModuleName -> String
55−runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
56−
57−readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])
58−readInput paths = do
59− content <- mapM (\path -> (path, ) <$> readFile path) paths
60− return $ map snd <$> P.parseModulesFromFiles id content
61−
62−compile :: HierarchyOptions -> IO ()
63−compile (HierarchyOptions inputGlob mOutput) = do
64− input <- glob inputGlob
65− modules <- readInput input
66− case modules of
67− Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure
68− Right ms -> do
69− for_ ms $ \(P.Module _ _ moduleName decls _) ->
70− let name = runModuleName moduleName
71− tcs = filter P.isTypeClassDeclaration decls
72− supers = sort . nub . filter (not . null) $ fmap superClasses tcs
73− prologue = "digraph " ++ name ++ " {\n"
74− body = intercalate "\n" (concatMap (fmap (\s -> " " ++ show s ++ ";")) supers)
75− epilogue = "\n}"
76− hier = prologue ++ body ++ epilogue
77− in unless (null supers) $ case mOutput of
78− Just output -> do
79− createDirectoryIfMissing True output
80− writeFile (output </> name) hier
81− Nothing -> putStrLn hier
82− exitSuccess
83−
84−superClasses :: P.Declaration -> [SuperMap]
85−superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =
86− fmap (\(P.Qualified _ super, _) -> SuperMap (Right (super, sub))) supers
87−superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]
88−superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl
89−superClasses _ = []
90−
91−inputFile :: Parser FilePath
92−inputFile = strArgument $
93− metavar "FILE"
94− <> value "main.purs"
95− <> showDefault
96− <> help "The input file to generate a hierarchy from"
97−
98−outputFile :: Parser (Maybe FilePath)
99−outputFile = optional . strOption $
100− short 'o'
101− <> long "output"
102− <> help "The output directory"
103−
104−pscOptions :: Parser HierarchyOptions
105−pscOptions = HierarchyOptions <$> inputFile
106− <*> outputFile
107−
108−main :: IO ()
109−main = execParser opts >>= compile
110− where
111− opts = info (helper <*> pscOptions) infoModList
112− infoModList = fullDesc <> headerInfo <> footerInfo
113− headerInfo = header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"
114− footerInfo = footer $ "hierarchy " ++ showVersion Paths.version
115−
license-generator/generate.hsdeleted−40
@@ -1,40 +0,0 @@
1−module Main (main) where
2−
3−import Control.Monad (forM_)
4−import Data.Char (isSpace)
5−import Data.List
6−import System.Process
7−import System.IO (hPutStrLn, stderr)
8−
9−echoHeader :: IO ()
10−echoHeader =
11− readFile "license-generator/header.txt" >>= putStr
12−
13−depsNames :: IO [String]
14−depsNames = do
15− i <- readProcess "cabal-dependency-licenses" [] ""
16− return $ sort $ map (drop 2) $ filter startsWithDash $ lines i
17− where
18− startsWithDash ('-' : _) = True
19− startsWithDash _ = False
20−
21−depsLicense :: String -> IO ()
22−depsLicense dep = do
23− let licenseFile = if dep == "Glob" then "LICENSE.txt" else "LICENSE"
24− hPutStrLn stderr dep
25− license <- readProcess "curl" ["--silent", "https://hackage.haskell.org/package/" ++ dep ++ "/src/" ++ licenseFile] ""
26− putStrLn $ dep ++ " LICENSE file:"
27− putStrLn ""
28− putStrLn $ f license
29− where
30− f = unlines . map trimEnd . map (" " ++) . lines
31− trimEnd = reverse . dropWhile isSpace . reverse
32−
33−main :: IO ()
34−main = do
35− deps <-depsNames
36− echoHeader
37− putStrLn ""
38− forM_ deps $ \d -> putStr " " >> putStrLn d
39− putStrLn ""
40− forM_ deps depsLicense
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.
logo.pngdeleted

Binary file not shown.

make_release_notesdeleted−2
@@ -1,2 +0,0 @@
1−curl https://api.github.com/repos/purescript/purescript/pulls?state=closed\&per_page=100 \
2− | jq -r '.[] | ("- " + .title + " (@" + .user.login + ")")'
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-bundle/Main.hsdeleted−146
@@ -1,146 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : psc-bundle
4−-- Copyright : (c) Phil Freeman 2015
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Bundles compiled PureScript modules for the browser.
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE FlexibleContexts #-}
16−{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE TupleSections #-}
18−{-# LANGUAGE RecordWildCards #-}
19−
20−module Main (main) where
21−
22−import Data.Traversable (for)
23−import Data.Version (showVersion)
24−
25−import Control.Applicative
26−import Control.Monad
27−import Control.Monad.Error.Class
28−import Control.Monad.Trans.Except
29−import Control.Monad.IO.Class
30−
31−import System.FilePath (takeFileName, takeDirectory)
32−import System.FilePath.Glob (glob)
33−import System.Exit (exitFailure)
34−import System.IO (stderr, hPutStrLn)
35−import System.Directory (createDirectoryIfMissing)
36−
37−import Language.PureScript.Bundle
38−
39−import Options.Applicative as Opts
40−
41−import qualified Paths_purescript as Paths
42−
43−-- | Command line options.
44−data Options = Options
45− { optionsInputFiles :: [FilePath]
46− , optionsOutputFile :: Maybe FilePath
47− , optionsEntryPoints :: [String]
48− , optionsMainModule :: Maybe String
49− , optionsNamespace :: String
50− , optionsRequirePath :: Maybe FilePath
51− } deriving Show
52−
53−-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
54−guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
55−guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)
56− where
57− guessModuleType "index.js" = pure Regular
58− guessModuleType "foreign.js" = pure Foreign
59− guessModuleType name = throwError $ UnsupportedModulePath name
60−
61−-- | The main application function.
62−-- This function parses the input files, performs dead code elimination, filters empty modules
63−-- and generates and prints the final Javascript bundle.
64−app :: (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String
65−app Options{..} = do
66− inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
67− when (null inputFiles) . liftIO $ do
68− hPutStrLn stderr "psc-bundle: No input files."
69− exitFailure
70− input <- for inputFiles $ \filename -> do
71− js <- liftIO (readFile filename)
72− mid <- guessModuleIdentifier filename
73− length js `seq` return (mid, js) -- evaluate readFile till EOF before returning, not to exhaust file handles
74−
75− let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints
76−
77− bundle input entryIds optionsMainModule optionsNamespace optionsRequirePath
78−
79−-- | Command line options parser.
80−options :: Parser Options
81−options = Options <$> some inputFile
82− <*> optional outputFile
83− <*> many entryPoint
84− <*> optional mainModule
85− <*> namespace
86− <*> optional requirePath
87− where
88− inputFile :: Parser FilePath
89− inputFile = strArgument $
90− metavar "FILE"
91− <> help "The input .js file(s)"
92−
93− outputFile :: Parser FilePath
94− outputFile = strOption $
95− short 'o'
96− <> long "output"
97− <> help "The output .js file"
98−
99− entryPoint :: Parser String
100− entryPoint = strOption $
101− short 'm'
102− <> long "module"
103− <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
104−
105− mainModule :: Parser String
106− mainModule = strOption $
107− long "main"
108− <> help "Generate code to run the main method in the specified module."
109−
110− namespace :: Parser String
111− namespace = strOption $
112− short 'n'
113− <> long "namespace"
114− <> Opts.value "PS"
115− <> showDefault
116− <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
117−
118− requirePath :: Parser FilePath
119− requirePath = strOption $
120− short 'r'
121− <> long "require-path"
122− <> Opts.value ""
123− <> help "The path prefix used in require() calls in the generated JavaScript"
124−
125−-- | Make it go.
126−main :: IO ()
127−main = do
128− opts <- execParser (info (version <*> helper <*> options) infoModList)
129− output <- runExceptT (app opts)
130− case output of
131− Left err -> do
132− hPutStrLn stderr (unlines (printErrorMessage err))
133− exitFailure
134− Right js ->
135− case optionsOutputFile opts of
136− Just outputFile -> do
137− createDirectoryIfMissing True (takeDirectory outputFile)
138− writeFile outputFile js
139− Nothing -> putStrLn js
140− where
141− infoModList = fullDesc <> headerInfo <> footerInfo
142− headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
143− footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
144−
145− version :: Parser (a -> a)
146− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psc-bundle/README.mddeleted−18
@@ -1,18 +0,0 @@
1−# psc-bundle
2−
3−A dead code elimination tool for PureScript-style CommonJS modules. This can be used as an alternative to Browserify.
4−
5−## Usage
6−
7− psc-bundle FILE (-m|--module ARG) [--main ARG] [--namespace ARG]
8−
9−Options:
10−
11−- The input .js file(s)
12−- Entry point module name(s) are specified with `-m` or `--module`. All code which is not a transitive dependency of an entry point module will be removed.
13−- The main module is (optionally) specified using `--main`. If specified, this will generate code to run the main method in the specified module.
14−- The browser namespace defaults to `PS`, and can be overridden with `--namespace`.
15−
16−For example, to bundle the modules in the `output` directory, with main module `Main`:
17−
18− psc-bundle output/**/*.js -m Main --main Main
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 . concatMap 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−13
@@ -1,13 +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 = concatMap 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 ++ ","
psc-docs/Main.hsdeleted−245
@@ -1,245 +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−import System.FilePath.Glob (glob)
38−
39−import Etags
40−import Ctags
41−import qualified Language.PureScript.Docs as D
42−import qualified Language.PureScript.Docs.AsMarkdown as D
43−
44−-- Available output formats
45−data Format = Markdown -- Output documentation in Markdown format
46− | Ctags -- Output ctags symbol index suitable for use with vi
47− | Etags -- Output etags symbol index suitable for use with emacs
48− deriving (Show, Eq, Ord)
49−
50−-- | Available methods of outputting Markdown documentation
51−data DocgenOutput
52− = EverythingToStdOut
53− | ToStdOut [P.ModuleName]
54− | ToFiles [(P.ModuleName, FilePath)]
55− deriving (Show)
56−
57−data PSCDocsOptions = PSCDocsOptions
58− { pscdFormat :: Format
59− , pscdInputFiles :: [FilePath]
60− , pscdDocgen :: DocgenOutput
61− }
62− deriving (Show)
63−
64−docgen :: PSCDocsOptions -> IO ()
65−docgen (PSCDocsOptions fmt inputGlob output) = do
66− input <- concat <$> mapM glob inputGlob
67− case fmt of
68− Etags -> dumpTags input dumpEtags
69− Ctags -> dumpTags input dumpCtags
70− Markdown -> do
71− e <- D.parseAndDesugar input [] (\_ ms -> return ms)
72− case e of
73− Left err -> do
74− hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
75− exitFailure
76− Right ms' ->
77− case output of
78− EverythingToStdOut ->
79− putStrLn (D.renderModulesAsMarkdown ms')
80− ToStdOut names -> do
81− let (ms, missing) = takeModulesByName ms' names
82− guardMissing missing
83− putStrLn (D.renderModulesAsMarkdown ms)
84− ToFiles names -> do
85− let (ms, missing) = takeModulesByName' ms' names
86− guardMissing missing
87− let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
88− forM_ ms'' $ \grp -> do
89− let fp = fst (head grp)
90− createDirectoryIfMissing True (takeDirectory fp)
91− writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
92− where
93− guardMissing [] = return ()
94− guardMissing [mn] = do
95− hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
96− exitFailure
97− guardMissing mns = do
98− hPutStrLn stderr "psc-docs: error: unknown modules:"
99− forM_ mns $ \mn ->
100− hPutStrLn stderr (" * " ++ show mn)
101− exitFailure
102−
103−-- |
104−-- Given a list of module names and a list of modules, return a list of modules
105−-- whose names appeared in the given name list, together with a list of names
106−-- for which no module could be found in the module list.
107−--
108−takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
109−takeModulesByName modules names =
110− first (map fst) (takeModulesByName' modules (map (,()) names))
111−
112−-- |
113−-- Like takeModulesByName but also keeps some extra data with the module.
114−--
115−takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
116−takeModulesByName' modules = foldl go ([], [])
117− where
118− go (ms, missing) (name, x) =
119− case find ((== name) . P.getModuleName) modules of
120− Just m -> ((m, x) : ms, missing)
121− Nothing -> (ms, name : missing)
122−
123−dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
124−dumpTags input renderTags = do
125− e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
126− case e of
127− Left err -> do
128− hPutStrLn stderr (show err)
129− exitFailure
130− Right ms ->
131− ldump (renderTags (pairs ms))
132−
133− where
134− pairs :: [(Maybe String, m)] -> [(String, m)]
135− pairs = map (first (fromMaybe ""))
136−
137− ldump :: [String] -> IO ()
138− ldump = mapM_ putStrLn
139−
140−parseFile :: FilePath -> IO (FilePath, String)
141−parseFile input = (,) input <$> readFile input
142−
143−inputFile :: Parser FilePath
144−inputFile = strArgument $
145− metavar "FILE"
146− <> help "The input .purs file(s)"
147−
148−instance Read Format where
149− readsPrec _ "etags" = [(Etags, "")]
150− readsPrec _ "ctags" = [(Ctags, "")]
151− readsPrec _ "markdown" = [(Markdown, "")]
152− readsPrec _ _ = []
153−
154−format :: Parser Format
155−format = option auto $ value Markdown
156− <> long "format"
157− <> metavar "FORMAT"
158− <> help "Set output FORMAT (markdown | etags | ctags)"
159−
160−docgenModule :: Parser String
161−docgenModule = strOption $
162− long "docgen"
163− <> 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."
164−
165−pscDocsOptions :: Parser (Format, [FilePath], [String])
166−pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
167−
168−parseDocgen :: [String] -> Either String DocgenOutput
169−parseDocgen [] = Right EverythingToStdOut
170−parseDocgen xs = go xs
171− where
172− go = intersperse " "
173− >>> concat
174− >>> words
175− >>> map parseItem
176− >>> combine
177−
178−data DocgenOutputItem
179− = IToStdOut P.ModuleName
180− | IToFile (P.ModuleName, FilePath)
181−
182−parseItem :: String -> DocgenOutputItem
183−parseItem s = case elemIndex ':' s of
184− Just i ->
185− s # splitAt i
186− >>> first P.moduleNameFromString
187− >>> second (drop 1)
188− >>> IToFile
189− Nothing ->
190− IToStdOut (P.moduleNameFromString s)
191−
192− where
193− infixr 1 #
194− (#) = flip ($)
195−
196−combine :: [DocgenOutputItem] -> Either String DocgenOutput
197−combine [] = Right EverythingToStdOut
198−combine (x:xs) = foldM go (initial x) xs
199− where
200− initial (IToStdOut m) = ToStdOut [m]
201− initial (IToFile m) = ToFiles [m]
202−
203− go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
204− go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
205− go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
206−
207−buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
208−buildOptions (fmt, input, mapping) =
209− case parseDocgen mapping of
210− Right mapping' -> return (PSCDocsOptions fmt input mapping')
211− Left err -> do
212− hPutStrLn stderr "psc-docs: error in --docgen option:"
213− hPutStrLn stderr (" " ++ err)
214− exitFailure
215−
216−main :: IO ()
217−main = execParser opts >>= buildOptions >>= docgen
218− where
219− opts = info (version <*> helper <*> pscDocsOptions) infoModList
220− infoModList = fullDesc <> headerInfo <> footerInfo
221− headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
222− footerInfo = footerDoc $ Just $ PP.vcat
223− [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
224−
225− version :: Parser (a -> a)
226− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
227−
228−examples :: PP.Doc
229−examples =
230− PP.vcat $ map PP.text
231− [ "Examples:"
232− , " print documentation for Data.List to stdout:"
233− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
234− , " --docgen Data.List"
235− , ""
236− , " write documentation for Data.List to docs/Data.List.md:"
237− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
238− , " --docgen Data.List:docs/Data.List.md"
239− , ""
240− , " write documentation for Data.List to docs/Data.List.md, and"
241− , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
242− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
243− , " --docgen Data.List:docs/Data.List.md \\"
244− , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
245− ]
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 _) = [P.showIdent ident]
14− names (P.ExternDeclaration ident _) = [P.showIdent ident]
15− names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]
16− names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]
17− names (P.TypeInstanceDeclaration name _ _ _ _) = [P.showIdent name]
18− names _ = []
psc-publish/Main.hsdeleted−45
@@ -1,45 +0,0 @@
1−
2−module Main where
3−
4−import Data.Version (Version(..), showVersion)
5−import qualified Data.Aeson as A
6−import qualified Data.ByteString.Lazy.Char8 as BL
7−
8−import Options.Applicative hiding (str)
9−
10−import qualified Paths_purescript as Paths
11−import Language.PureScript.Publish
12−import Language.PureScript.Publish.ErrorsWarnings
13−
14−dryRun :: Parser Bool
15−dryRun = switch $
16− long "dry-run"
17− <> help "Produce no output, and don't require a tagged version to be checked out."
18−
19−dryRunOptions :: PublishOptions
20−dryRunOptions = defaultPublishOptions
21− { publishGetVersion = return dummyVersion
22− , publishWorkingTreeDirty = warn DirtyWorkingTree_Warn
23− }
24− where dummyVersion = ("0.0.0", Version [0,0,0] [])
25−
26−main :: IO ()
27−main = execParser opts >>= publish
28− where
29− opts = info (version <*> helper <*> dryRun) infoModList
30− infoModList = fullDesc <> headerInfo <> footerInfo
31− headerInfo = header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"
32− footerInfo = footer $ "psc-publish " ++ showVersion Paths.version
33−
34− version :: Parser (a -> a)
35− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
36−
37−publish :: Bool -> IO ()
38−publish isDryRun =
39− if isDryRun
40− then do
41− _ <- preparePackage dryRunOptions
42− putStrLn "Dry run completed, no errors."
43− else do
44− pkg <- preparePackage defaultPublishOptions
45− BL.putStrLn (A.encode pkg)
psc/JSON.hsdeleted−69
@@ -1,69 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5−-- License : MIT (http://opensource.org/licenses/MIT)
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE TemplateHaskell #-}
16−
17−module JSON where
18−
19−import Prelude ()
20−import Prelude.Compat
21−
22−import qualified Data.Aeson.TH as A
23−
24−import qualified Language.PureScript as P
25−
26−data ErrorPosition = ErrorPosition
27− { startLine :: Int
28− , startColumn :: Int
29− , endLine :: Int
30− , endColumn :: Int
31− }
32−
33−data JSONError = JSONError
34− { position :: Maybe ErrorPosition
35− , message :: String
36− , errorCode :: String
37− , filename :: Maybe String
38− , moduleName :: Maybe String
39− }
40−
41−data JSONResult = JSONResult
42− { warnings :: [JSONError]
43− , errors :: [JSONError]
44− }
45−
46−$(A.deriveJSON A.defaultOptions ''ErrorPosition)
47−$(A.deriveJSON A.defaultOptions ''JSONError)
48−$(A.deriveJSON A.defaultOptions ''JSONResult)
49−
50−toJSONErrors :: Bool -> P.Level -> P.MultipleErrors -> [JSONError]
51−toJSONErrors verbose level = map (toJSONError verbose level) . P.runMultipleErrors
52−
53−toJSONError :: Bool -> P.Level -> P.ErrorMessage -> JSONError
54−toJSONError verbose level e =
55− JSONError (toErrorPosition <$> sspan)
56− (P.renderBox (P.prettyPrintSingleError verbose level (P.stripModuleAndSpan e)))
57− (P.errorCode e)
58− (P.spanName <$> sspan)
59− (P.runModuleName <$> P.errorModule e)
60− where
61− sspan :: Maybe P.SourceSpan
62− sspan = P.errorSpan e
63−
64− toErrorPosition :: P.SourceSpan -> ErrorPosition
65− toErrorPosition ss =
66− ErrorPosition (P.sourcePosLine (P.spanStart ss))
67− (P.sourcePosColumn (P.spanStart ss))
68− (P.sourcePosLine (P.spanEnd ss))
69− (P.sourcePosColumn (P.spanEnd ss))
psc/Main.hsdeleted−207
@@ -1,207 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5−-- License : MIT (http://opensource.org/licenses/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.Strict
26−
27−import Data.List (isSuffixOf, partition)
28−import Data.Version (showVersion)
29−import qualified Data.Map as M
30−import qualified Data.Aeson as A
31−import qualified Data.ByteString.Lazy as B
32−import qualified Data.ByteString.UTF8 as BU8
33−
34−import Options.Applicative as Opts
35−
36−import System.Exit (exitSuccess, exitFailure)
37−import System.IO (hPutStrLn, stderr)
38−import System.IO.UTF8
39−import System.FilePath.Glob (glob)
40−
41−import qualified Language.PureScript as P
42−import qualified Paths_purescript as Paths
43−
44−import Language.PureScript.Make
45−
46−import JSON
47−
48−data PSCMakeOptions = PSCMakeOptions
49− { pscmInput :: [FilePath]
50− , pscmForeignInput :: [FilePath]
51− , pscmOutputDir :: FilePath
52− , pscmOpts :: P.Options
53− , pscmUsePrefix :: Bool
54− , pscmJSONErrors :: Bool
55− }
56−
57−data InputOptions = InputOptions
58− { ioInputFiles :: [FilePath]
59− }
60−
61−-- | Argumnets: verbose, use JSON, warnings, errors
62−printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
63−printWarningsAndErrors verbose False warnings errors = do
64− when (P.nonEmpty warnings) $
65− hPutStrLn stderr (P.prettyPrintMultipleWarnings verbose warnings)
66− case errors of
67− Left errs -> do
68− hPutStrLn stderr (P.prettyPrintMultipleErrors verbose errs)
69− exitFailure
70− Right _ -> return ()
71−printWarningsAndErrors verbose True warnings errors = do
72− hPutStrLn stderr . BU8.toString . B.toStrict . A.encode $
73− JSONResult (toJSONErrors verbose P.Warning warnings)
74− (either (toJSONErrors verbose P.Error) (const []) errors)
75− either (const exitFailure) (const (return ())) errors
76−
77−compile :: PSCMakeOptions -> IO ()
78−compile PSCMakeOptions{..} = do
79− input <- globWarningOnMisses warnFileTypeNotFound pscmInput
80− when (null input) $ do
81− hPutStrLn stderr "psc: No input files."
82− exitFailure
83− let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
84− moduleFiles <- readInput (InputOptions pursFiles)
85− inputForeign <- globWarningOnMisses warnFileTypeNotFound pscmForeignInput
86− foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)
87− (makeErrors, makeWarnings) <- runMake pscmOpts $ do
88− (ms, foreigns) <- parseInputs moduleFiles foreignFiles
89− let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
90− makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix
91− P.make makeActions (map snd ms)
92− printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors
93− exitSuccess
94−
95−warnFileTypeNotFound :: String -> IO ()
96−warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
97−
98−globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
99−globWarningOnMisses warn = concatMapM globWithWarning
100− where
101− globWithWarning pattern = do
102− paths <- glob pattern
103− when (null paths) $ warn pattern
104− return paths
105− concatMapM f = liftM concat . mapM f
106−
107−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
108−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
109−
110−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
111− => [(Either P.RebuildPolicy FilePath, String)]
112− -> [(FilePath, P.ForeignJS)]
113− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
114−parseInputs modules foreigns =
115− (,) <$> P.parseModulesFromFiles (either (const "") id) modules
116− <*> P.parseForeignModulesFromFiles foreigns
117−
118−inputFile :: Parser FilePath
119−inputFile = strArgument $
120− metavar "FILE"
121− <> help "The input .purs file(s)"
122−
123−inputForeignFile :: Parser FilePath
124−inputForeignFile = strOption $
125− short 'f'
126− <> long "ffi"
127− <> help "The input .js file(s) providing foreign import implementations"
128−
129−outputDirectory :: Parser FilePath
130−outputDirectory = strOption $
131− short 'o'
132− <> long "output"
133− <> Opts.value "output"
134− <> showDefault
135− <> help "The output directory"
136−
137−requirePath :: Parser (Maybe FilePath)
138−requirePath = optional $ strOption $
139− short 'r'
140− <> long "require-path"
141− <> help "The path prefix to use for require() calls in the generated JavaScript"
142−
143−noTco :: Parser Bool
144−noTco = switch $
145− long "no-tco"
146− <> help "Disable tail call optimizations"
147−
148−noMagicDo :: Parser Bool
149−noMagicDo = switch $
150− long "no-magic-do"
151− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
152−
153−noOpts :: Parser Bool
154−noOpts = switch $
155− long "no-opts"
156− <> help "Skip the optimization phase"
157−
158−comments :: Parser Bool
159−comments = switch $
160− short 'c'
161− <> long "comments"
162− <> help "Include comments in the generated code"
163−
164−verboseErrors :: Parser Bool
165−verboseErrors = switch $
166− short 'v'
167− <> long "verbose-errors"
168− <> help "Display verbose error messages"
169−
170−noPrefix :: Parser Bool
171−noPrefix = switch $
172− short 'p'
173− <> long "no-prefix"
174− <> help "Do not include comment header"
175−
176−jsonErrors :: Parser Bool
177−jsonErrors = switch $
178− long "json-errors"
179− <> help "Print errors to stderr as JSON"
180−
181−options :: Parser P.Options
182−options = P.Options <$> noTco
183− <*> noMagicDo
184− <*> pure Nothing
185− <*> noOpts
186− <*> verboseErrors
187− <*> (not <$> comments)
188− <*> requirePath
189−
190−pscMakeOptions :: Parser PSCMakeOptions
191−pscMakeOptions = PSCMakeOptions <$> many inputFile
192− <*> many inputForeignFile
193− <*> outputDirectory
194− <*> options
195− <*> (not <$> noPrefix)
196− <*> jsonErrors
197−
198−main :: IO ()
199−main = execParser opts >>= compile
200− where
201− opts = info (version <*> helper <*> pscMakeOptions) infoModList
202− infoModList = fullDesc <> headerInfo <> footerInfo
203− headerInfo = header "psc - Compiles PureScript to Javascript"
204− footerInfo = footer $ "psc " ++ showVersion Paths.version
205−
206− version :: Parser (a -> a)
207− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psci/Completion.hsdeleted−226
@@ -1,226 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−
3−module Completion where
4−
5−import Prelude ()
6−import Prelude.Compat
7−
8−import Data.Maybe (mapMaybe)
9−import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)
10−import Data.Char (isUpper)
11−import Data.Function (on)
12−
13−import Control.Arrow (second)
14−import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
15−import Control.Monad.Trans.State.Strict
16−
17−import System.Console.Haskeline
18−
19−import qualified Language.PureScript as P
20−import qualified Language.PureScript.Names as N
21−
22−import qualified Directive as D
23−import Types
24−
25−-- Completions may read the state, but not modify it.
26−type CompletionM = ReaderT PSCiState IO
27−
28−-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.
29−liftCompletionM :: CompletionM a -> StateT PSCiState IO a
30−liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)
31−
32−-- Haskeline completions
33−
34−data CompletionContext
35− = CtxDirective String
36− | CtxFilePath String
37− | CtxModule
38− | CtxIdentifier
39− | CtxType
40− | CtxFixed String
41− deriving (Show, Read)
42−
43−-- |
44−-- Loads module, function, and file completions.
45−--
46−completion :: CompletionFunc (StateT PSCiState IO)
47−completion = liftCompletionM . completion'
48−
49−completion' :: CompletionFunc CompletionM
50−completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
51−
52−-- |
53−-- Decide what kind of completion we need based on input. This function expects
54−-- a list of complete words (to the left of the cursor) as the first argument,
55−-- and the current word as the second argument.
56−completionContext :: [String] -> String -> [CompletionContext]
57−completionContext [] _ = [CtxDirective "", CtxIdentifier, CtxFixed "import"]
58−completionContext ws w | headSatisfies (":" `isPrefixOf`) ws = completeDirective ws w
59−completionContext ws w | headSatisfies (== "import") ws = completeImport ws w
60−completionContext _ _ = [CtxIdentifier]
61−
62−completeDirective :: [String] -> String -> [CompletionContext]
63−completeDirective ws w =
64− case ws of
65− [] -> [CtxDirective w]
66− [dir] -> case D.directivesFor <$> stripPrefix ":" dir of
67− -- only offer completions if the directive is unambiguous
68− Just [dir'] -> directiveArg w dir'
69− _ -> []
70−
71− -- All directives take exactly one argument. If we haven't yet matched,
72− -- that means one argument has already been supplied. So don't complete
73− -- any others.
74− _ -> []
75−
76−directiveArg :: String -> Directive -> [CompletionContext]
77−directiveArg _ Browse = [CtxModule]
78−directiveArg w Load = [CtxFilePath w]
79−directiveArg w Foreign = [CtxFilePath w]
80−directiveArg _ Quit = []
81−directiveArg _ Reset = []
82−directiveArg _ Help = []
83−directiveArg _ Show = map CtxFixed replQueryStrings
84−directiveArg _ Type = [CtxIdentifier]
85−directiveArg _ Kind = [CtxType]
86−
87−completeImport :: [String] -> String -> [CompletionContext]
88−completeImport ws w' =
89− case (ws, w') of
90− (["import"], w) | headSatisfies isUpper w -> [CtxModule]
91− (["import"], _) -> [CtxModule, CtxFixed "qualified"]
92− (["import", "qualified"], _) -> [CtxModule]
93− _ -> []
94−
95−headSatisfies :: (a -> Bool) -> [a] -> Bool
96−headSatisfies p str =
97− case str of
98− (c:_) -> p c
99− _ -> False
100−
101−-- | Callback for Haskeline's `completeWordWithPrev`.
102−-- Expects:
103−-- * Line contents to the left of the word, reversed
104−-- * Word to be completed
105−findCompletions :: String -> String -> CompletionM [Completion]
106−findCompletions prev word = do
107− let ctx = completionContext (words (reverse prev)) word
108− completions <- concat <$> traverse getCompletions ctx
109− return $ sortBy directivesFirst completions
110− where
111− getCompletions :: CompletionContext -> CompletionM [Completion]
112− getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
113−
114− prefixedBy :: String -> String -> Maybe Completion
115− prefixedBy w cand = if w `isPrefixOf` cand
116− then Just (simpleCompletion cand)
117− else Nothing
118−
119−getCompletion :: CompletionContext -> CompletionM [Either String Completion]
120−getCompletion ctx =
121− case ctx of
122− CtxFilePath f -> map Right <$> listFiles f
123− CtxModule -> map Left <$> getModuleNames
124− CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
125− CtxType -> map Left <$> getTypeNames
126− CtxFixed str -> return [Left str]
127− CtxDirective d -> return (map Left (completeDirectives d))
128−
129− where
130− completeDirectives :: String -> [String]
131− completeDirectives = map (':' :) . D.directiveStringsFor
132−
133−
134−getLoadedModules :: CompletionM [P.Module]
135−getLoadedModules = asks (map snd . psciLoadedModules)
136−
137−getImportedModules :: CompletionM [ImportedModule]
138−getImportedModules = asks psciImportedModules
139−
140−getModuleNames :: CompletionM [String]
141−getModuleNames = moduleNames <$> getLoadedModules
142−
143−mapLoadedModulesAndQualify :: (a -> String) -> (P.Module -> [(a, P.Declaration)]) -> CompletionM [String]
144−mapLoadedModulesAndQualify sho f = do
145− ms <- getLoadedModules
146− let argPairs = do m <- ms
147− fm <- f m
148− return (m, fm)
149− concat <$> traverse (uncurry (getAllQualifications sho)) argPairs
150−
151−getIdentNames :: CompletionM [String]
152−getIdentNames = mapLoadedModulesAndQualify P.showIdent identNames
153−
154−getDctorNames :: CompletionM [String]
155−getDctorNames = mapLoadedModulesAndQualify P.runProperName dctorNames
156−
157−getTypeNames :: CompletionM [String]
158−getTypeNames = mapLoadedModulesAndQualify P.runProperName typeDecls
159−
160−-- | Given a module and a declaration in that module, return all possible ways
161−-- it could have been referenced given the current PSCiState - including fully
162−-- qualified, qualified using an alias, and unqualified.
163−getAllQualifications :: (a -> String) -> P.Module -> (a, P.Declaration) -> CompletionM [String]
164−getAllQualifications sho m (declName, decl) = do
165− imports <- getAllImportsOf m
166− let fullyQualified = qualifyWith (Just (P.getModuleName m))
167− let otherQuals = nub (concatMap qualificationsUsing imports)
168− return $ fullyQualified : otherQuals
169− where
170− qualifyWith mMod = P.showQualified sho (P.Qualified mMod declName)
171− referencedBy refs = P.isExported (Just refs) decl
172−
173− qualificationsUsing (_, importType, asQ') =
174− let q = qualifyWith asQ'
175− in case importType of
176− P.Implicit -> [q]
177− P.Explicit refs -> [q | referencedBy refs]
178− P.Hiding refs -> [q | not $ referencedBy refs]
179−
180−
181−-- | Returns all the ImportedModule values referring to imports of a particular
182−-- module.
183−getAllImportsOf :: P.Module -> CompletionM [ImportedModule]
184−getAllImportsOf = asks . allImportsOf
185−
186−nubOnFst :: Eq a => [(a, b)] -> [(a, b)]
187−nubOnFst = nubBy ((==) `on` fst)
188−
189−typeDecls :: P.Module -> [(N.ProperName 'N.TypeName, P.Declaration)]
190−typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations
191− where
192− getTypeName :: P.Declaration -> Maybe (N.ProperName 'N.TypeName, P.Declaration)
193− getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)
194− getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)
195− getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
196− getTypeName _ = Nothing
197−
198−identNames :: P.Module -> [(N.Ident, P.Declaration)]
199−identNames = nubOnFst . concatMap getDeclNames . P.exportedDeclarations
200− where
201− getDeclNames :: P.Declaration -> [(P.Ident, P.Declaration)]
202− getDeclNames d@(P.ValueDeclaration ident _ _ _) = [(ident, d)]
203− getDeclNames d@(P.TypeDeclaration ident _ ) = [(ident, d)]
204− getDeclNames d@(P.ExternDeclaration ident _) = [(ident, d)]
205− getDeclNames d@(P.TypeClassDeclaration _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds
206− getDeclNames (P.PositionedDeclaration _ _ d) = getDeclNames d
207− getDeclNames _ = []
208−
209−dctorNames :: P.Module -> [(N.ProperName 'N.ConstructorName, P.Declaration)]
210−dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
211− where
212− go :: P.Declaration -> [(N.ProperName 'N.ConstructorName, P.Declaration)]
213− go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)
214− go (P.PositionedDeclaration _ _ d) = go d
215− go _ = []
216−
217−moduleNames :: [P.Module] -> [String]
218−moduleNames ms = nub [P.runModuleName moduleName | P.Module _ _ moduleName _ _ <- ms]
219−
220−directivesFirst :: Completion -> Completion -> Ordering
221−directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
222− where
223− go (':' : xs) (':' : ys) = compare xs ys
224− go (':' : _) _ = LT
225− go _ (':' : _) = GT
226− go xs ys = compare xs ys
psci/Directive.hsdeleted−115
@@ -1,115 +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− , (Foreign, ["foreign"])
42− , (Type , ["type"])
43− , (Kind , ["kind"])
44− , (Show , ["show"])
45− ]
46−
47−-- |
48−-- Like directiveStrings, but the other way around.
49−--
50−directiveStrings' :: [(String, Directive)]
51−directiveStrings' = concatMap go directiveStrings
52− where
53− go (dir, strs) = map (\s -> (s, dir)) strs
54−
55−-- |
56−-- List of all directive strings.
57−--
58−strings :: [String]
59−strings = concatMap snd directiveStrings
60−
61−-- |
62−-- Returns all possible string representations of a directive.
63−--
64−stringsFor :: Directive -> [String]
65−stringsFor d = fromJust (lookup d directiveStrings)
66−
67−-- |
68−-- Returns the default string representation of a directive.
69−--
70−stringFor :: Directive -> String
71−stringFor = head . stringsFor
72−
73−-- |
74−-- Returns the list of directives which could be expanded from the string
75−-- argument, together with the string alias that matched.
76−--
77−directivesFor' :: String -> [(Directive, String)]
78−directivesFor' str = go directiveStrings'
79− where
80− go = map swap . filter ((str `isPrefixOf`) . fst)
81−
82−directivesFor :: String -> [Directive]
83−directivesFor = map fst . directivesFor'
84−
85−directiveStringsFor :: String -> [String]
86−directiveStringsFor = map snd . directivesFor'
87−
88−parseDirective :: String -> Maybe Directive
89−parseDirective = listToMaybe . directivesFor
90−
91−-- |
92−-- True if the given directive takes an argument, false otherwise.
93−hasArgument :: Directive -> Bool
94−hasArgument Help = False
95−hasArgument Quit = False
96−hasArgument Reset = False
97−hasArgument _ = True
98−
99−-- |
100−-- The help menu.
101−--
102−help :: [(Directive, String, String)]
103−help =
104− [ (Help, "", "Show this help menu")
105− , (Quit, "", "Quit PSCi")
106− , (Reset, "", "Discard all imported modules and declared bindings")
107− , (Browse, "<module>", "See all functions in <module>")
108− , (Load, "<file>", "Load <file> for importing")
109− , (Foreign, "<file>", "Load foreign module <file>")
110− , (Type, "<expr>", "Show the type of <expr>")
111− , (Kind, "<type>", "Show the kind of <type>")
112− , (Show, "import", "Show all imported modules")
113− , (Show, "loaded", "Show all loaded modules")
114− ]
115−
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/PSCi.hsdeleted−688
@@ -1,688 +0,0 @@
1−{-# LANGUAGE DoAndIfThenElse #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE TupleSections #-}
5−{-# LANGUAGE DataKinds #-}
6−
7−-- |
8−-- PureScript Compiler Interactive.
9−--
10−module PSCi where
11−
12−import Prelude ()
13−import Prelude.Compat
14−
15−import Data.Foldable (traverse_)
16−import Data.Maybe (mapMaybe)
17−import Data.List (intersperse, intercalate, nub, sort)
18−import Data.Tuple (swap)
19−import Data.Version (showVersion)
20−import qualified Data.Map as M
21−
22−import Control.Arrow (first)
23−import Control.Monad
24−import Control.Monad.Error.Class (MonadError(..))
25−import Control.Monad.Trans.Class
26−import Control.Monad.Trans.Except (ExceptT(), runExceptT)
27−import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
28−import Control.Monad.Trans.State.Strict
29−import Control.Monad.IO.Class (liftIO)
30−import Control.Monad.Writer.Strict (Writer(), runWriter)
31−
32−import Options.Applicative as Opts
33−
34−import System.Console.Haskeline
35−import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)
36−import System.Exit
37−import System.FilePath (pathSeparator, (</>), isPathSeparator)
38−import System.FilePath.Glob (glob)
39−import System.Process (readProcessWithExitCode)
40−import System.IO.Error (tryIOError)
41−import qualified Text.PrettyPrint.Boxes as Box
42−
43−import qualified Language.PureScript as P
44−import qualified Language.PureScript.Names as N
45−import qualified Paths_purescript as Paths
46−
47−import qualified Directive as D
48−import Completion (completion)
49−import IO (mkdirp)
50−import Parser (parseCommand)
51−import Types
52−
53−-- | The name of the PSCI support module
54−supportModuleName :: P.ModuleName
55−supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]
56−
57−-- | Support module, contains code to evaluate terms
58−supportModule :: P.Module
59−supportModule =
60− case P.parseModulesFromFiles id [("", code)] of
61− Right [(_, P.Module ss cs _ ds exps)] -> P.Module ss cs supportModuleName ds exps
62− _ -> P.internalError "Support module could not be parsed"
63− where
64− code :: String
65− code = unlines
66− [ "module S where"
67− , ""
68− , "import Prelude"
69− , "import Control.Monad.Eff"
70− , "import Control.Monad.Eff.Console"
71− , "import Control.Monad.Eff.Unsafe"
72− , ""
73− , "class Eval a where"
74− , " eval :: a -> Eff (console :: CONSOLE) Unit"
75− , ""
76− , "instance evalShow :: (Show a) => Eval a where"
77− , " eval = print"
78− , ""
79− , "instance evalEff :: (Eval a) => Eval (Eff eff a) where"
80− , " eval x = unsafeInterleaveEff x >>= eval"
81− ]
82−
83−-- File helpers
84−
85−onFirstFileMatching :: Monad m => (b -> m (Maybe a)) -> [b] -> m (Maybe a)
86−onFirstFileMatching f pathVariants = runMaybeT . msum $ map (MaybeT . f) pathVariants
87−
88−-- |
89−-- Locates the node executable.
90−-- Checks for either @nodejs@ or @node@.
91−--
92−findNodeProcess :: IO (Maybe String)
93−findNodeProcess = onFirstFileMatching findExecutable names
94− where names = ["nodejs", "node"]
95−
96−-- |
97−-- Grabs the filename where the history is stored.
98−--
99−getHistoryFilename :: IO FilePath
100−getHistoryFilename = do
101− home <- getHomeDirectory
102− let filename = home </> ".purescript" </> "psci_history"
103− mkdirp filename
104− return filename
105−
106−-- |
107−-- Loads a file for use with imports.
108−--
109−loadModule :: FilePath -> IO (Either String [P.Module])
110−loadModule filename = do
111− content <- readFile filename
112− return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
113−
114−-- |
115−-- Load all modules.
116−--
117−loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])
118−loadAllModules files = do
119− filesAndContent <- forM files $ \filename -> do
120− content <- readFile filename
121− return (filename, content)
122− return $ P.parseModulesFromFiles id filesAndContent
123−
124−-- |
125−-- Load all modules, updating the application state
126−--
127−loadAllImportedModules :: PSCI ()
128−loadAllImportedModules = do
129− files <- PSCI . lift $ fmap psciImportedFilenames get
130− modulesOrFirstError <- psciIO $ loadAllModules files
131− case modulesOrFirstError of
132− Left errs -> printErrors errs
133− Right modules -> PSCI . lift . modify $ updateModules modules
134−
135−-- |
136−-- Expands tilde in path.
137−--
138−expandTilde :: FilePath -> IO FilePath
139−expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
140−expandTilde p = return p
141−
142−-- Messages
143−
144−-- |
145−-- The help message.
146−--
147−helpMessage :: String
148−helpMessage = "The following commands are available:\n\n " ++
149− intercalate "\n " (map line D.help) ++
150− "\n\n" ++ extraHelp
151− where
152− line :: (Directive, String, String) -> String
153− line (dir, arg, desc) =
154− let cmd = ':' : D.stringFor dir
155− in unwords [ cmd
156− , replicate (11 - length cmd) ' '
157− , arg
158− , replicate (11 - length arg) ' '
159− , desc
160− ]
161−
162− extraHelp =
163− "Further information is available on the PureScript wiki:\n" ++
164− " --> https://github.com/purescript/purescript/wiki/psci"
165−
166−
167−-- |
168−-- The welcome prologue.
169−--
170−prologueMessage :: String
171−prologueMessage = intercalate "\n"
172− [ " ____ ____ _ _ "
173− , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
174− , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
175− , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
176− , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
177− , " |_| "
178− , ""
179− , ":? shows help"
180− ]
181−
182−-- |
183−-- The quit message.
184−--
185−quitMessage :: String
186−quitMessage = "See ya!"
187−
188−-- |
189−-- PSCI monad
190−--
191−newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
192−
193−psciIO :: IO a -> PSCI a
194−psciIO io = PSCI . lift $ lift io
195−
196−-- |
197−-- Makes a volatile module to execute the current expression.
198−--
199−createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module
200−createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =
201− let
202− moduleName = P.ModuleName [P.ProperName "$PSCI"]
203− trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))
204− mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))
205− itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val
206− mainDecl = P.ValueDeclaration (P.Ident "$main") P.Public [] $ Right mainValue
207− decls = if exec then [itDecl, mainDecl] else [itDecl]
208− in
209− P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
210−
211−
212−-- |
213−-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
214−--
215−createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
216−createTemporaryModuleForKind PSCiState{psciImportedModules = imports, psciLetBindings = lets} typ =
217− let
218− moduleName = P.ModuleName [P.ProperName "$PSCI"]
219− itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
220− in
221− P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ [itDecl]) Nothing
222−
223−-- |
224−-- Makes a volatile module to execute the current imports.
225−--
226−createTemporaryModuleForImports :: PSCiState -> P.Module
227−createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
228− let
229− moduleName = P.ModuleName [P.ProperName "$PSCI"]
230− in
231− P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName (importDecl `map` imports) Nothing
232−
233−importDecl :: ImportedModule -> P.Declaration
234−importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ False
235−
236−indexFile :: FilePath
237−indexFile = ".psci_modules" ++ pathSeparator : "index.js"
238−
239−modulesDir :: FilePath
240−modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
241−
242−-- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the
243−-- options and ignores the warning messages.
244−runMake :: P.Make a -> IO (Either P.MultipleErrors a)
245−runMake mk = fst <$> P.runMake P.defaultOptions mk
246−
247−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> P.Make a
248−makeIO f io = do
249− e <- liftIO $ tryIOError io
250− either (throwError . P.singleError . f) return e
251−
252−make :: PSCiState -> [P.Module] -> P.Make P.Environment
253−make st@PSCiState{..} ms = P.make actions' (map snd loadedModules ++ ms)
254− where
255− filePathMap = M.fromList $ (first P.getModuleName . swap) `map` allModules
256− actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False
257− actions' = actions { P.progress = const (return ()) }
258− loadedModules = psciLoadedModules st
259− allModules = map (first Right) loadedModules ++ map (Left P.RebuildAlways,) ms
260−
261−-- |
262−-- Takes a value expression and evaluates it with the current state.
263−--
264−handleExpression :: P.Expr -> PSCI ()
265−handleExpression val = do
266− st <- PSCI $ lift get
267− let m = createTemporaryModule True st val
268− let nodeArgs = psciNodeFlags st ++ [indexFile]
269− e <- psciIO . runMake $ make st [supportModule, m]
270− case e of
271− Left errs -> printErrors errs
272− Right _ -> do
273− psciIO $ writeFile indexFile "require('$PSCI')['$main']();"
274− process <- psciIO findNodeProcess
275− result <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
276− case result of
277− Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
278− Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
279− Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
280−
281−-- |
282−-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
283−-- restore the original environment.
284−--
285−handleDecls :: [P.Declaration] -> PSCI ()
286−handleDecls ds = do
287− st <- PSCI $ lift get
288− let st' = updateLets ds st
289− let m = createTemporaryModule False st' (P.ObjectLiteral [])
290− e <- psciIO . runMake $ make st' [m]
291− case e of
292− Left err -> printErrors err
293− Right _ -> PSCI $ lift (put st')
294−
295−-- |
296−-- Show actual loaded modules in psci.
297−--
298−handleShowLoadedModules :: PSCI ()
299−handleShowLoadedModules = do
300− loadedModules <- PSCI $ lift $ gets psciLoadedModules
301− psciIO $ readModules loadedModules >>= putStrLn
302− return ()
303− where readModules = return . unlines . sort . nub . map toModuleName
304− toModuleName = N.runModuleName . (\ (P.Module _ _ mdName _ _) -> mdName) . snd
305−
306−-- |
307−-- Show the imported modules in psci.
308−--
309−handleShowImportedModules :: PSCI ()
310−handleShowImportedModules = do
311− PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get
312− psciIO $ showModules importedModules >>= putStrLn
313− return ()
314− where
315− showModules = return . unlines . sort . map showModule
316− showModule (mn, declType, asQ) =
317− "import " ++ case asQ of
318− Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
319− Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
320−
321− showDeclType P.Implicit = ""
322− showDeclType (P.Explicit refs) = refsList refs
323− showDeclType (P.Hiding refs) = " hiding " ++ refsList refs
324− refsList refs = " (" ++ commaList (map showRef refs) ++ ")"
325−
326− showRef :: P.DeclarationRef -> String
327− showRef (P.TypeRef pn dctors) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
328− showRef (P.ValueRef ident) = N.runIdent ident
329− showRef (P.TypeClassRef pn) = N.runProperName pn
330− showRef (P.ProperRef pn) = pn
331− showRef (P.TypeInstanceRef ident) = N.runIdent ident
332− showRef (P.ModuleRef name) = "module " ++ N.runModuleName name
333− showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
334−
335− commaList :: [String] -> String
336− commaList = intercalate ", "
337−
338−-- |
339−-- Imports a module, preserving the initial state on failure.
340−--
341−handleImport :: ImportedModule -> PSCI ()
342−handleImport im = do
343− st <- updateImportedModules im <$> PSCI (lift get)
344− let m = createTemporaryModuleForImports st
345− e <- psciIO . runMake $ make st [m]
346− case e of
347− Left errs -> printErrors errs
348− Right _ -> do
349− PSCI $ lift $ put st
350− return ()
351−
352−-- |
353−-- Takes a value and prints its type
354−--
355−handleTypeOf :: P.Expr -> PSCI ()
356−handleTypeOf val = do
357− st <- PSCI $ lift get
358− let m = createTemporaryModule False st val
359− e <- psciIO . runMake $ make st [m]
360− case e of
361− Left errs -> printErrors errs
362− Right env' ->
363− case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
364− Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
365− Nothing -> PSCI $ outputStrLn "Could not find type"
366−
367−-- |
368−-- Pretty print a module's signatures
369−--
370−printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()
371−printModuleSignatures moduleName (P.Environment {..}) =
372− PSCI $
373− -- get relevant components of a module from environment
374− let moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) names
375− moduleTypeClasses = (filter (\(P.Qualified maybeName _) -> maybeName == Just moduleName) . M.keys) typeClasses
376− moduleTypes = (filter (\(P.Qualified maybeName _) -> maybeName == Just moduleName) . M.keys) types
377−
378− in
379− -- print each component
380− (outputStr . unlines . map trimEnd . lines . Box.render . Box.vsep 1 Box.left)
381− [ printModule's (mapMaybe (showTypeClass . findTypeClass typeClasses)) moduleTypeClasses -- typeClasses
382− , printModule's (mapMaybe (showType typeClasses dataConstructors typeSynonyms . findType types)) moduleTypes -- types
383− , printModule's (map (showNameType . findNameType names)) moduleNamesIdent -- functions
384− ]
385−
386− where printModule's showF = Box.vsep 1 Box.left . showF
387−
388− findNameType :: 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))
389− findNameType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)
390−
391− showNameType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> Box.Box
392− showNameType (mIdent, Just (mType, _, _)) = Box.text (P.showIdent mIdent ++ " :: ") Box.<> P.typeAsBox mType
393− showNameType _ = P.internalError "The impossible happened in printModuleSignatures."
394−
395− findTypeClass
396− :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint])
397− -> P.Qualified (P.ProperName 'P.ClassName)
398− -> (P.Qualified (P.ProperName 'P.ClassName), Maybe ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint]))
399− findTypeClass envTypeClasses name = (name, M.lookup name envTypeClasses)
400−
401− showTypeClass
402− :: (P.Qualified (P.ProperName 'P.ClassName), Maybe ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint]))
403− -> Maybe Box.Box
404− showTypeClass (_, Nothing) = Nothing
405− showTypeClass (P.Qualified _ name, Just (vars, body, constrs)) =
406− let constraints =
407− if null constrs
408− then Box.text ""
409− else Box.text "("
410− Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Qualified _ pn, lt) -> Box.text (P.runProperName pn) Box.<+> Box.hcat Box.left (map P.typeAtomAsBox lt)) constrs)
411− Box.<> Box.text ") <= "
412− className =
413− Box.text (P.runProperName name)
414− Box.<> Box.text (concatMap ((' ':) . fst) vars)
415− classBody =
416− Box.vcat Box.top (map (\(i, t) -> Box.text (P.showIdent i ++ " ::") Box.<+> P.typeAsBox t) body)
417−
418− in
419− Just $
420− (Box.text "class "
421− Box.<> constraints
422− Box.<> className
423− Box.<+> if null body then Box.text "" else Box.text "where")
424− Box.// Box.moveRight 2 classBody
425−
426−
427− findType
428− :: M.Map (P.Qualified (P.ProperName 'P.TypeName)) (P.Kind, P.TypeKind)
429− -> P.Qualified (P.ProperName 'P.TypeName)
430− -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.Kind, P.TypeKind))
431− findType envTypes name = (name, M.lookup name envTypes)
432−
433− showType
434− :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint])
435− -> M.Map (P.Qualified (P.ProperName 'P.ConstructorName)) (P.DataDeclType, P.ProperName 'P.TypeName, P.Type, [P.Ident])
436− -> M.Map (P.Qualified (P.ProperName 'P.TypeName)) ([(String, Maybe P.Kind)], P.Type)
437− -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.Kind, P.TypeKind))
438− -> Maybe Box.Box
439− showType typeClassesEnv dataConstructorsEnv typeSynonymsEnv (n@(P.Qualified modul name), typ) =
440− case (typ, M.lookup n typeSynonymsEnv) of
441− (Just (_, P.TypeSynonym), Just (typevars, dtType)) ->
442− if M.member (fmap P.coerceProperName n) typeClassesEnv
443− then
444− Nothing
445− else
446− Just $
447− Box.text ("type " ++ P.runProperName name ++ concatMap ((' ':) . fst) typevars)
448− Box.// Box.moveRight 2 (Box.text "=" Box.<+> P.typeAsBox dtType)
449−
450− (Just (_, P.DataType typevars pt), _) ->
451− let prefix =
452− case pt of
453− [(dtProperName,_)] ->
454− case M.lookup (P.Qualified modul dtProperName) dataConstructorsEnv of
455− Just (dataDeclType, _, _, _) -> P.showDataDeclType dataDeclType
456− _ -> "data"
457− _ -> "data"
458−
459− in
460− Just $ Box.text (prefix ++ " " ++ P.runProperName name ++ concatMap ((' ':) . fst) typevars) Box.// printCons pt
461−
462− _ ->
463− Nothing
464−
465− where printCons pt =
466− Box.moveRight 2 $
467− Box.vcat Box.left $
468− mapFirstRest (Box.text "=" Box.<+>) (Box.text "|" Box.<+>) $
469− map (\(cons,idents) -> (Box.text (P.runProperName cons) Box.<> Box.hcat Box.left (map prettyPrintType idents))) pt
470−
471− prettyPrintType t = Box.text " " Box.<> P.typeAtomAsBox t
472−
473− mapFirstRest _ _ [] = []
474− mapFirstRest f g (x:xs) = f x : map g xs
475−
476− trimEnd = reverse . dropWhile (== ' ') . reverse
477−
478−
479−-- |
480−-- Browse a module and displays its signature (if module exists).
481−--
482−handleBrowse :: P.ModuleName -> PSCI ()
483−handleBrowse moduleName = do
484− st <- PSCI $ lift get
485− env <- psciIO . runMake $ make st []
486− case env of
487− Left errs -> printErrors errs
488− Right env' ->
489− if moduleName `notElem` (nub . map ((\ (P.Module _ _ modName _ _ ) -> modName) . snd)) (psciLoadedModules st)
490− then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."
491− else printModuleSignatures moduleName env'
492−
493−-- | Pretty-print errors
494−printErrors :: P.MultipleErrors -> PSCI ()
495−printErrors = PSCI . outputStrLn . P.prettyPrintMultipleErrors False
496−
497−-- |
498−-- Takes a value and prints its kind
499−--
500−handleKindOf :: P.Type -> PSCI ()
501−handleKindOf typ = do
502− st <- PSCI $ lift get
503− let m = createTemporaryModuleForKind st typ
504− mName = P.ModuleName [P.ProperName "$PSCI"]
505− e <- psciIO . runMake $ make st [m]
506− case e of
507− Left errs -> printErrors errs
508− Right env' ->
509− case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
510− Just (_, typ') -> do
511− let chk = (P.emptyCheckState env') { P.checkCurrentModule = Just mName }
512− k = check (P.kindOf typ') chk
513−
514− check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)
515− check sew cs = fst . runWriter . runExceptT . runStateT sew $ cs
516− case k of
517− Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
518− Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
519− Nothing -> PSCI $ outputStrLn "Could not find kind"
520−
521−-- Commands
522−
523−-- |
524−-- Parses the input and returns either a Metacommand, or an error as a string.
525−--
526−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
527−getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do
528− firstLine <- withInterrupt $ getInputLine "> "
529− case firstLine of
530− Nothing -> return (Right (Just QuitPSCi)) -- Ctrl-D when input is empty
531− Just "" -> return (Right Nothing)
532− Just s | singleLineMode || head s == ':' -> return .fmap Just $ parseCommand s
533− Just s -> fmap Just . parseCommand <$> go [s]
534− where
535− go :: [String] -> InputT (StateT PSCiState IO) String
536− go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
537−
538−-- |
539−-- Performs an action for each meta-command given, and also for expressions.
540−--
541−handleCommand :: Command -> PSCI ()
542−handleCommand (Expression val) = handleExpression val
543−handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
544−handleCommand (Import im) = handleImport im
545−handleCommand (Decls l) = handleDecls l
546−handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do
547− m <- psciIO $ loadModule absPath
548− case m of
549− Left err -> PSCI $ outputStrLn err
550− Right mods -> PSCI . lift $ modify (updateModules (map (absPath,) mods))
551−handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do
552− foreignsOrError <- psciIO . runMake $ do
553− foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readFile absPath)
554− P.parseForeignModulesFromFiles [(absPath, foreignFile)]
555− case foreignsOrError of
556− Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err
557− Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)
558−handleCommand ResetState = do
559− PSCI . lift . modify $ \st ->
560− st { psciImportedModules = []
561− , psciLetBindings = []
562− }
563− loadAllImportedModules
564−handleCommand (TypeOf val) = handleTypeOf val
565−handleCommand (KindOf typ) = handleKindOf typ
566−handleCommand (BrowseModule moduleName) = handleBrowse moduleName
567−handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
568−handleCommand (ShowInfo QueryImport) = handleShowImportedModules
569−handleCommand QuitPSCi = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."
570−
571−whenFileExists :: FilePath -> (FilePath -> PSCI ()) -> PSCI ()
572−whenFileExists filePath f = do
573− absPath <- psciIO $ expandTilde filePath
574− exists <- psciIO $ doesFileExist absPath
575− if exists
576− then f absPath
577− else PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
578−
579−-- |
580−-- Attempts to read initial commands from '.psci' in the present working
581−-- directory then the user's home
582−--
583−loadUserConfig :: IO (Maybe [Command])
584−loadUserConfig = onFirstFileMatching readCommands pathGetters
585− where
586− pathGetters = [getCurrentDirectory, getHomeDirectory]
587− readCommands :: IO FilePath -> IO (Maybe [Command])
588− readCommands path = do
589− configFile <- (</> ".psci") <$> path
590− exists <- doesFileExist configFile
591− if exists
592− then do
593− ls <- lines <$> readFile configFile
594− case traverse parseCommand ls of
595− Left err -> print err >> exitFailure
596− Right cs -> return $ Just cs
597− else
598− return Nothing
599−
600−
601−-- | Checks if the Console module is defined
602−consoleIsDefined :: [P.Module] -> Bool
603−consoleIsDefined = any ((== P.ModuleName (map P.ProperName [ "Control", "Monad", "Eff", "Console" ])) . P.getModuleName)
604−
605−-- |
606−-- The PSCI main loop.
607−--
608−loop :: PSCiOptions -> IO ()
609−loop PSCiOptions{..} = do
610− config <- loadUserConfig
611− inputFiles <- concat <$> traverse glob psciInputFile
612− foreignFiles <- concat <$> traverse glob psciForeignInputFiles
613− modulesOrFirstError <- loadAllModules inputFiles
614− case modulesOrFirstError of
615− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
616− Right modules -> do
617− historyFilename <- getHistoryFilename
618− let settings = defaultSettings { historyFile = Just historyFilename }
619− foreignsOrError <- runMake $ do
620− foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.ErrorMessage [] $ P.CannotReadFile inFile)) (readFile inFile))
621− P.parseForeignModulesFromFiles foreignFilesContent
622− case foreignsOrError of
623− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
624− Right foreigns ->
625− flip evalStateT (mkPSCiState [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
626− outputStrLn prologueMessage
627− traverse_ (traverse_ (runPSCI . handleCommand)) config
628− modules' <- lift $ gets psciLoadedModules
629− unless (consoleIsDefined (map snd modules')) . outputStrLn $ unlines
630− [ "PSCi requires the purescript-console module to be installed."
631− , "For help getting started, visit http://wiki.purescript.org/PSCi"
632− ]
633− go
634− where
635− go :: InputT (StateT PSCiState IO) ()
636− go = do
637− c <- getCommand (not psciMultiLineMode)
638− case c of
639− Left err -> outputStrLn err >> go
640− Right Nothing -> go
641− Right (Just QuitPSCi) -> outputStrLn quitMessage
642− Right (Just c') -> do
643− handleInterrupt (outputStrLn "Interrupted.")
644− (withInterrupt (runPSCI (loadAllImportedModules >> handleCommand c')))
645− go
646−
647−multiLineMode :: Parser Bool
648−multiLineMode = switch $
649− long "multi-line-mode"
650− <> short 'm'
651− <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
652−
653−inputFile :: Parser FilePath
654−inputFile = strArgument $
655− metavar "FILE"
656− <> Opts.help "Optional .purs files to load on start"
657−
658−inputForeignFile :: Parser FilePath
659−inputForeignFile = strOption $
660− short 'f'
661− <> long "ffi"
662− <> help "The input .js file(s) providing foreign import implementations"
663−
664−nodeFlagsFlag :: Parser [String]
665−nodeFlagsFlag = option parser $
666− long "node-opts"
667− <> metavar "NODE_OPTS"
668− <> value []
669− <> Opts.help "Flags to pass to node, separated by spaces"
670− where
671− parser = words <$> str
672−
673−psciOptions :: Parser PSCiOptions
674−psciOptions = PSCiOptions <$> multiLineMode
675− <*> many inputFile
676− <*> many inputForeignFile
677− <*> nodeFlagsFlag
678−
679−runPSCi :: IO ()
680−runPSCi = execParser opts >>= loop
681− where
682− opts = info (version <*> helper <*> psciOptions) infoModList
683− infoModList = fullDesc <> headerInfo <> footerInfo
684− headerInfo = header "psci - Interactive mode for PureScript"
685− footerInfo = footer $ "psci " ++ showVersion Paths.version
686−
687− version :: Parser (a -> a)
688− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
psci/Parser.hsdeleted−140
@@ -1,140 +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 ()
21−import Prelude.Compat hiding (lex)
22−
23−import Data.Char (isSpace)
24−import Data.List (intercalate)
25−
26−import Text.Parsec hiding ((<|>))
27−
28−import qualified Language.PureScript as P
29−import Language.PureScript.Parser.Common (mark, same)
30−
31−import qualified Directive as D
32−import Types
33−
34−-- |
35−-- Parses PSCI metacommands or expressions input from the user.
36−--
37−parseCommand :: String -> Either String Command
38−parseCommand cmdString =
39− case cmdString of
40− (':' : cmd) -> parseDirective cmd
41− _ -> parseRest psciCommand cmdString
42−
43−parseRest :: P.TokenParser a -> String -> Either String a
44−parseRest p s = either (Left . show) Right $ do
45− ts <- P.lex "" s
46− P.runTokenParser "" (p <* eof) ts
47−
48−psciCommand :: P.TokenParser Command
49−psciCommand = choice (map try parsers)
50− where
51− parsers =
52− [ psciLet
53− , psciImport
54− , psciOtherDeclaration
55− , psciExpression
56− ]
57−
58−trim :: String -> String
59−trim = trimEnd . trimStart
60−
61−trimStart :: String -> String
62−trimStart = dropWhile isSpace
63−
64−trimEnd :: String -> String
65−trimEnd = reverse . trimStart . reverse
66−
67−parseDirective :: String -> Either String Command
68−parseDirective cmd =
69− case D.directivesFor' dstr of
70− [(d, _)] -> commandFor d
71− [] -> Left "Unrecognized directive. Type :? for help."
72− ds -> Left ("Ambiguous directive. Possible matches: " ++
73− intercalate ", " (map snd ds) ++ ". Type :? for help.")
74− where
75− (dstr, arg) = break isSpace cmd
76−
77− commandFor d = case d of
78− Help -> return ShowHelp
79− Quit -> return QuitPSCi
80− Reset -> return ResetState
81− Browse -> BrowseModule <$> parseRest P.moduleName arg
82− Load -> return $ LoadFile (trim arg)
83− Foreign -> return $ LoadForeign (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 = do
110− (mn, declType, asQ, _) <- P.parseImportDeclaration'
111− return $ Import (mn, declType, asQ)
112−
113−-- | Any other declaration that we don't need a 'special case' parser for
114−-- (like let or import declarations).
115−psciOtherDeclaration :: P.TokenParser Command
116−psciOtherDeclaration = Decls . (:[]) <$> do
117− decl <- discardPositionInfo <$> P.parseDeclaration
118− if acceptable decl
119− then return decl
120− else fail "this kind of declaration is not supported in psci"
121−
122−discardPositionInfo :: P.Declaration -> P.Declaration
123−discardPositionInfo (P.PositionedDeclaration _ _ d) = d
124−discardPositionInfo d = d
125−
126−acceptable :: P.Declaration -> Bool
127−acceptable P.DataDeclaration{} = True
128−acceptable P.TypeSynonymDeclaration{} = True
129−acceptable P.ExternDeclaration{} = True
130−acceptable P.ExternDataDeclaration{} = True
131−acceptable P.TypeClassDeclaration{} = True
132−acceptable P.TypeInstanceDeclaration{} = True
133−acceptable _ = False
134−
135−parseReplQuery' :: String -> Either String ReplQuery
136−parseReplQuery' str =
137− case parseReplQuery str of
138− Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++
139− intercalate ", " replQueryStrings ++ ".")
140− Just query -> Right query
psci/Types.hsdeleted−215
@@ -1,215 +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 Control.Arrow (second)
19−import Data.Map (Map)
20−import qualified Data.Map as Map
21−import qualified Language.PureScript as P
22−
23−data PSCiOptions = PSCiOptions
24− { psciMultiLineMode :: Bool
25− , psciInputFile :: [FilePath]
26− , psciForeignInputFiles :: [FilePath]
27− , psciInputNodeFlags :: [String]
28− }
29−
30−-- |
31−-- The PSCI state.
32−-- Holds a list of imported modules, loaded files, and partial let bindings.
33−-- The let bindings are partial,
34−-- because it makes more sense to apply the binding to the final evaluated expression.
35−--
36−data PSCiState = PSCiState
37− { psciImportedModules :: [ImportedModule]
38− , _psciLoadedModules :: Map FilePath [P.Module]
39− , psciForeignFiles :: Map P.ModuleName FilePath
40− , psciLetBindings :: [P.Declaration]
41− , psciNodeFlags :: [String]
42− }
43−
44−initialPSCiState :: PSCiState
45−initialPSCiState =
46− PSCiState [] Map.empty Map.empty [] []
47−
48−mkPSCiState :: [ImportedModule]
49− -> [(FilePath, P.Module)]
50− -> Map P.ModuleName FilePath
51− -> [P.Declaration]
52− -> [String]
53− -> PSCiState
54−mkPSCiState imported loaded foreign lets nodeFlags =
55− (initialPSCiState
56− |> each imported updateImportedModules
57− |> updateModules loaded)
58− { psciForeignFiles = foreign
59− , psciLetBindings = lets
60− , psciNodeFlags = nodeFlags
61− }
62− where
63− x |> f = f x
64− each xs f st = foldl (flip f) st xs
65−
66−-- Public psci state accessors
67−
68−-- | Get the imported filenames as a list.
69−psciImportedFilenames :: PSCiState -> [FilePath]
70−psciImportedFilenames = Map.keys . _psciLoadedModules
71−
72−-- | Get the loaded modules as a list.
73−psciLoadedModules :: PSCiState -> [(FilePath, P.Module)]
74−psciLoadedModules = collect . Map.toList . _psciLoadedModules
75− where
76− collect :: [(k, [v])] -> [(k, v)]
77− collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
78−
79−-- | All of the data that is contained by an ImportDeclaration in the AST.
80−-- That is:
81−--
82−-- * A module name, the name of the module which is being imported
83−-- * An ImportDeclarationType which specifies whether there is an explicit
84−-- import list, a hiding list, or neither.
85−-- * If the module is imported qualified, its qualified name in the importing
86−-- module. Otherwise, Nothing.
87−--
88−type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)
89−
90−psciImportedModuleNames :: PSCiState -> [P.ModuleName]
91−psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
92− map (\(mn, _, _) -> mn) is
93−
94−allImportsOf :: P.Module -> PSCiState -> [ImportedModule]
95−allImportsOf m (PSCiState{psciImportedModules = is}) =
96− filter isImportOfThis is
97− where
98− name = P.getModuleName m
99− isImportOfThis (name', _, _) = name == name'
100−
101−-- State helpers
102−
103−-- |
104−-- Updates the state to have more imported modules.
105−--
106−updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
107−updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
108−
109−-- |
110−-- Updates the state to have more loaded modules (available for import, but
111−-- not necessarily imported).
112−--
113−updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState
114−updateModules modules st =
115− st { _psciLoadedModules = Map.union (go modules) (_psciLoadedModules st) }
116− where
117− go = Map.fromListWith (++) . map (second (:[]))
118−
119−-- |
120−-- Updates the state to have more let bindings.
121−--
122−updateLets :: [P.Declaration] -> PSCiState -> PSCiState
123−updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
124−
125−-- |
126−-- Updates the state to have more let bindings.
127−--
128−updateForeignFiles :: Map P.ModuleName FilePath -> PSCiState -> PSCiState
129−updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `Map.union` fs }
130−
131−-- |
132−-- Valid Meta-commands for PSCI
133−--
134−data Command
135− -- |
136− -- A purescript expression
137− --
138− = Expression P.Expr
139− -- |
140− -- Show the help (ie, list of directives)
141− --
142− | ShowHelp
143− -- |
144− -- Import a module from a loaded file
145− --
146− | Import ImportedModule
147− -- |
148− -- Browse a module
149− --
150− | BrowseModule P.ModuleName
151− -- |
152− -- Load a file for use with importing
153− --
154− | LoadFile FilePath
155− -- |
156− -- Load a foreign module
157− --
158− | LoadForeign FilePath
159− -- |
160− -- Exit PSCI
161− --
162− | QuitPSCi
163− -- |
164− -- Reset the state of the REPL
165− --
166− | ResetState
167− -- |
168− -- Add some declarations to the current evaluation context.
169− --
170− | Decls [P.Declaration]
171− -- |
172− -- Find the type of an expression
173− --
174− | TypeOf P.Expr
175− -- |
176− -- Find the kind of an expression
177− --
178− | KindOf P.Type
179− -- |
180− -- Shows information about the current state of the REPL
181− --
182− | ShowInfo ReplQuery
183−
184−data ReplQuery
185− = QueryLoaded
186− | QueryImport
187− deriving (Eq, Show)
188−
189−-- | A list of all ReplQuery values.
190−replQueries :: [ReplQuery]
191−replQueries = [QueryLoaded, QueryImport]
192−
193−replQueryStrings :: [String]
194−replQueryStrings = map showReplQuery replQueries
195−
196−showReplQuery :: ReplQuery -> String
197−showReplQuery QueryLoaded = "loaded"
198−showReplQuery QueryImport = "import"
199−
200−parseReplQuery :: String -> Maybe ReplQuery
201−parseReplQuery "loaded" = Just QueryLoaded
202−parseReplQuery "import" = Just QueryImport
203−parseReplQuery _ = Nothing
204−
205−data Directive
206− = Help
207− | Quit
208− | Reset
209− | Browse
210− | Load
211− | Foreign
212− | Type
213− | Kind
214− | Show
215− 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−162
@@ -1,162 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−{-# LANGUAGE TupleSections #-}
3−
4−module Main where
5−
6−import Prelude ()
7−import Prelude.Compat
8−
9−import Control.Monad.Trans.State.Strict (runStateT)
10−import Control.Monad (when, forM)
11−import Control.Monad.Writer.Strict (runWriterT)
12−import Control.Monad.Trans.Except (runExceptT)
13−
14−import Data.List (sort)
15−
16−import System.Exit (exitFailure)
17−import System.Console.Haskeline
18−import System.FilePath ((</>))
19−import System.Directory (getCurrentDirectory)
20−import qualified System.FilePath.Glob as Glob
21−
22−import Test.HUnit
23−
24−import qualified Language.PureScript as P
25−
26−import PSCi
27−import Completion
28−import Types
29−
30−import TestsSetup
31−
32−main :: IO ()
33−main = do
34− fetchSupportCode
35− Counts{..} <- runTestTT allTests
36− when (errors + failures > 0) exitFailure
37−
38−allTests :: Test
39−allTests = completionTests
40−
41−completionTests :: Test
42−completionTests =
43− TestLabel "completionTests"
44− (TestList (map (TestCase . assertCompletedOk) completionTestData))
45−
46−-- If the cursor is at the right end of the line, with the 1st element of the
47−-- pair as the text in the line, then pressing tab should offer all the
48−-- elements of the list (which is the 2nd element) as completions.
49−completionTestData :: [(String, [String])]
50−completionTestData =
51− -- basic directives
52− [ (":h", [":help"])
53− , (":re", [":reset"])
54− , (":q", [":quit"])
55− , (":mo", [":module"])
56− , (":b", [":browse"])
57−
58− -- :browse should complete module names
59− , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
60− , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
61−
62− -- import should complete module names
63− , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
64− , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
65− , ("import qualified Control.Monad.Eff.", map ("import qualified Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
66−
67− -- :load, :module should complete file paths
68− , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])
69− , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])
70−
71− -- :quit, :help, :reset should not complete
72− , (":help ", [])
73− , (":quit ", [])
74− , (":reset ", [])
75−
76− -- :show should complete to "loaded" and "import"
77− , (":show ", [":show import", ":show loaded"])
78− , (":show a", [])
79−
80− -- :type should complete values and data constructors in scope
81− , (":type Control.Monad.Eff.Console.lo", [":type Control.Monad.Eff.Console.log"])
82− , (":type uni", [":type unit"])
83− , (":type E", [":type EQ"])
84−
85− -- :kind should complete types in scope
86− , (":kind C", [":kind Control.Monad.Eff.Pure"])
87− , (":kind O", [":kind Ordering"])
88−
89− -- Only one argument for directives should be completed
90− , (":show import ", [])
91− , (":type EQ ", [])
92− , (":kind Ordering ", [])
93−
94− -- a few other import tests
95− , ("impor", ["import"])
96− , ("import q", ["import qualified"])
97− , ("import ", map ("import " ++) supportModules ++ ["import qualified"])
98− , ("import Prelude ", [])
99−
100− -- String and number literals should not be completed
101− , ("\"hi", [])
102− , ("34", [])
103−
104− -- Identifiers and data constructors should be completed
105− , ("uni", ["unit"])
106− , ("Control.Monad.Eff.Class.", ["Control.Monad.Eff.Class.liftEff"])
107− , ("G", ["GT"])
108− , ("Prelude.L", ["Prelude.LT"])
109−
110− -- if a module is imported qualified, values should complete under the
111− -- qualified name, as well as the original name.
112− , ("ST.new", ["ST.newSTRef"])
113− , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
114− ]
115− where
116−
117−assertCompletedOk :: (String, [String]) -> Assertion
118−assertCompletedOk (line, expecteds) = do
119− (unusedR, completions) <- runCM (completion' (reverse line, ""))
120− let unused = reverse unusedR
121− let actuals = map ((unused ++) . replacement) completions
122− sort expecteds @=? sort actuals
123−
124−runCM :: CompletionM a -> IO a
125−runCM act = do
126− psciState <- getPSCiState
127− fmap fst (runStateT (liftCompletionM act) psciState)
128−
129−getPSCiState :: IO PSCiState
130−getPSCiState = do
131− cwd <- getCurrentDirectory
132− let supportDir = cwd </> "tests" </> "support" </> "flattened"
133− let supportFiles ext = Glob.globDir1 (Glob.compile ("*." ++ ext)) supportDir
134− pursFiles <- supportFiles "purs"
135− jsFiles <- supportFiles "js"
136−
137− modulesOrFirstError <- loadAllModules pursFiles
138− foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)
139− Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
140− case modulesOrFirstError of
141− Left err ->
142− print err >> exitFailure
143− Right modules ->
144− let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
145− in return (mkPSCiState imports modules foreigns [] [])
146−
147−controlMonadSTasST :: ImportedModule
148−controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
149− where
150− s = P.moduleNameFromString
151−
152−supportModules :: [String]
153−supportModules =
154− [ "Control.Monad.Eff.Class"
155− , "Control.Monad.Eff.Console"
156− , "Control.Monad.Eff"
157− , "Control.Monad.Eff.Unsafe"
158− , "Control.Monad.ST"
159− , "Data.Function"
160− , "Prelude"
161− , "Test.Assert"
162− ]
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−289
@@ -1,289 +0,0 @@
1−name: purescript
2−version: 0.8.0.0
3−cabal-version: >=1.8
4−build-type: Simple
5−license: MIT
6−license-file: LICENSE
7−copyright: (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
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− Harry Garrood <harry@garrood.me>
18−
19−tested-with: GHC==7.8
20−
21−extra-source-files: examples/passing/*.purs
22− , examples/failing/*.purs
23− , tests/support/setup.js
24− , tests/support/package.json
25− , tests/support/bower.json
26− , tests/support/setup-win.cmd
27− , psci/tests/data/Sample.purs
28− , stack.yaml
29− , stack-lts-2.yaml
30− , stack-lts-3.yaml
31− , stack-nightly.yaml
32− , README.md
33− , INSTALL.md
34− , CONTRIBUTORS.md
35− , CONTRIBUTING.md
36−
37−source-repository head
38− type: git
39− location: https://github.com/purescript/purescript.git
40−
41−library
42− build-depends: base >=4.6 && <5,
43− base-compat >=0.6.0,
44− lifted-base >= 0.2.3 && < 0.2.4,
45− monad-control >= 1.0.0.0 && < 1.1,
46− transformers-base >= 0.4.0 && < 0.5,
47− containers -any,
48− unordered-containers -any,
49− dlist -any,
50− directory >= 1.2,
51− filepath -any,
52− mtl >= 2.1.0 && < 2.3.0,
53− parsec -any,
54− transformers >= 0.3.0 && < 0.5,
55− transformers-compat >= 0.3.0,
56− utf8-string >= 1 && < 2,
57− pattern-arrows >= 0.0.2 && < 0.1,
58− time -any,
59− boxes >= 0.1.4 && < 0.2.0,
60− aeson >= 0.8 && < 0.11,
61− vector -any,
62− bower-json >= 0.7,
63− aeson-better-errors >= 0.8,
64− bytestring -any,
65− text -any,
66− split -any,
67− language-javascript == 0.5.*,
68− syb -any,
69− Glob >= 0.7 && < 0.8,
70− process >= 1.2.0 && < 1.4,
71− safe >= 0.3.9 && < 0.4,
72− semigroups >= 0.16.2 && < 0.19,
73− parallel >= 3.2 && < 3.3
74−
75− exposed-modules: Language.PureScript
76− Language.PureScript.AST
77− Language.PureScript.AST.Binders
78− Language.PureScript.AST.Declarations
79− Language.PureScript.AST.Operators
80− Language.PureScript.AST.SourcePos
81− Language.PureScript.AST.Traversals
82− Language.PureScript.AST.Exported
83− Language.PureScript.Bundle
84− Language.PureScript.Crash
85− Language.PureScript.Externs
86− Language.PureScript.CodeGen
87− Language.PureScript.CodeGen.JS
88− Language.PureScript.CodeGen.JS.AST
89− Language.PureScript.CodeGen.JS.Common
90− Language.PureScript.CodeGen.JS.Optimizer
91− Language.PureScript.CodeGen.JS.Optimizer.Blocks
92− Language.PureScript.CodeGen.JS.Optimizer.Common
93− Language.PureScript.CodeGen.JS.Optimizer.Inliner
94− Language.PureScript.CodeGen.JS.Optimizer.MagicDo
95− Language.PureScript.CodeGen.JS.Optimizer.TCO
96− Language.PureScript.CodeGen.JS.Optimizer.Unused
97− Language.PureScript.Constants
98− Language.PureScript.CoreFn
99− Language.PureScript.CoreFn.Ann
100− Language.PureScript.CoreFn.Binders
101− Language.PureScript.CoreFn.Desugar
102− Language.PureScript.CoreFn.Expr
103− Language.PureScript.CoreFn.Literals
104− Language.PureScript.CoreFn.Meta
105− Language.PureScript.CoreFn.Module
106− Language.PureScript.CoreFn.Traversals
107− Language.PureScript.Comments
108− Language.PureScript.Environment
109− Language.PureScript.Errors
110− Language.PureScript.Kinds
111− Language.PureScript.Linter
112− Language.PureScript.Linter.Exhaustive
113− Language.PureScript.Linter.Imports
114− Language.PureScript.Make
115− Language.PureScript.ModuleDependencies
116− Language.PureScript.Names
117− Language.PureScript.Options
118− Language.PureScript.Parser
119− Language.PureScript.Parser.Lexer
120− Language.PureScript.Parser.Common
121− Language.PureScript.Parser.Declarations
122− Language.PureScript.Parser.JS
123− Language.PureScript.Parser.Kinds
124− Language.PureScript.Parser.State
125− Language.PureScript.Parser.Types
126− Language.PureScript.Pretty
127− Language.PureScript.Pretty.Common
128− Language.PureScript.Pretty.JS
129− Language.PureScript.Pretty.Kinds
130− Language.PureScript.Pretty.Types
131− Language.PureScript.Pretty.Values
132− Language.PureScript.Renamer
133− Language.PureScript.Sugar
134− Language.PureScript.Sugar.BindingGroups
135− Language.PureScript.Sugar.CaseDeclarations
136− Language.PureScript.Sugar.DoNotation
137− Language.PureScript.Sugar.Names
138− Language.PureScript.Sugar.Names.Env
139− Language.PureScript.Sugar.Names.Imports
140− Language.PureScript.Sugar.Names.Exports
141− Language.PureScript.Sugar.ObjectWildcards
142− Language.PureScript.Sugar.Operators
143− Language.PureScript.Sugar.TypeClasses
144− Language.PureScript.Sugar.TypeClasses.Deriving
145− Language.PureScript.Sugar.TypeDeclarations
146− Language.PureScript.Traversals
147− Language.PureScript.TypeChecker
148− Language.PureScript.TypeChecker.Entailment
149− Language.PureScript.TypeChecker.Kinds
150− Language.PureScript.TypeChecker.Monad
151− Language.PureScript.TypeChecker.Rows
152− Language.PureScript.TypeChecker.Skolems
153− Language.PureScript.TypeChecker.Subsumption
154− Language.PureScript.TypeChecker.Synonyms
155− Language.PureScript.TypeChecker.Types
156− Language.PureScript.TypeChecker.Unify
157− Language.PureScript.TypeClassDictionaries
158− Language.PureScript.Types
159−
160− Language.PureScript.Docs
161− Language.PureScript.Docs.Convert
162− Language.PureScript.Docs.Render
163− Language.PureScript.Docs.Types
164− Language.PureScript.Docs.RenderedCode
165− Language.PureScript.Docs.RenderedCode.Types
166− Language.PureScript.Docs.RenderedCode.Render
167− Language.PureScript.Docs.AsMarkdown
168− Language.PureScript.Docs.ParseAndDesugar
169− Language.PureScript.Docs.Utils.MonoidExtras
170−
171− Language.PureScript.Publish
172− Language.PureScript.Publish.Utils
173− Language.PureScript.Publish.ErrorsWarnings
174− Language.PureScript.Publish.BoxesHelpers
175−
176− Control.Monad.Logger
177− Control.Monad.Supply
178− Control.Monad.Supply.Class
179−
180− System.IO.UTF8
181−
182− extensions: DataKinds
183− exposed: True
184− buildable: True
185− hs-source-dirs: src
186− other-modules: Paths_purescript
187− ghc-options: -Wall -O2
188−
189−executable psc
190− build-depends: base >=4 && <5, base-compat >=0.6.0,
191− containers -any, directory -any, filepath -any,
192− mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
193− time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8,
194− aeson >= 0.8 && < 0.11, bytestring -any, utf8-string >= 1 && < 2
195− main-is: Main.hs
196− buildable: True
197− hs-source-dirs: psc
198− other-modules: JSON
199− ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"
200−
201−executable psci
202− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
203− mtl -any, optparse-applicative >= 0.10.0, parsec -any,
204− haskeline >= 0.7.0.0, purescript -any, transformers -any,
205− transformers-compat -any, process -any, time -any, Glob -any, base-compat >=0.6.0,
206− boxes >= 0.1.4 && < 0.2.0
207−
208− main-is: Main.hs
209− buildable: True
210− hs-source-dirs: psci psci/main
211− other-modules: Types
212− Parser
213− Directive
214− Completion
215− PSCi
216− IO
217− ghc-options: -Wall -O2
218−
219−executable psc-docs
220− build-depends: base >=4 && <5, purescript -any,
221− optparse-applicative >= 0.10.0, process -any, mtl -any,
222− split -any, ansi-wl-pprint -any, directory -any,
223− filepath -any, Glob -any
224− main-is: Main.hs
225− buildable: True
226− hs-source-dirs: psc-docs
227− other-modules: Ctags
228− Etags
229− Tags
230− ghc-options: -Wall -O2
231−
232−executable psc-publish
233− build-depends: base >=4 && <5, purescript -any, bytestring -any, aeson -any, optparse-applicative -any
234− main-is: Main.hs
235− buildable: True
236− hs-source-dirs: psc-publish
237− ghc-options: -Wall -O2
238−
239−executable psc-hierarchy
240− build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
241− process -any, mtl -any, parsec -any, filepath -any, directory -any,
242− Glob -any
243− main-is: Main.hs
244− buildable: True
245− hs-source-dirs: hierarchy
246− other-modules:
247− ghc-options: -Wall -O2
248−
249−executable psc-bundle
250− main-is: Main.hs
251− other-modules:
252− other-extensions:
253− build-depends: base >=4 && <5,
254− purescript -any,
255− filepath -any,
256− directory -any,
257− mtl -any,
258− transformers -any,
259− transformers-compat -any,
260− optparse-applicative >= 0.10.0,
261− Glob -any
262− ghc-options: -Wall -O2
263− hs-source-dirs: psc-bundle
264−
265−test-suite tests
266− build-depends: base >=4 && <5, containers -any, directory -any,
267− filepath -any, mtl -any, parsec -any, purescript -any,
268− transformers -any, process -any, transformers-compat -any, time -any,
269− Glob -any, aeson-better-errors -any, bytestring -any, aeson -any,
270− base-compat -any
271− type: exitcode-stdio-1.0
272− main-is: Main.hs
273− other-modules: TestsSetup
274− TestPscPublish
275− buildable: True
276− hs-source-dirs: tests tests/common
277−
278−test-suite psci-tests
279− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
280− mtl -any, optparse-applicative >= 0.10.0, parsec -any,
281− haskeline >= 0.7.0.0, purescript -any, transformers -any,
282− transformers-compat -any, process -any, HUnit -any, time -any,
283− Glob -any, base-compat >=0.6.0, boxes >= 0.1.4 && < 0.2.0
284− type: exitcode-stdio-1.0
285− main-is: Main.hs
286− other-modules: TestsSetup
287− buildable: True
288− hs-source-dirs: psci psci/tests tests/common
289− 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/Logger.hsdeleted−72
@@ -1,72 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Control.Monad.Logger
4−-- Author : Phil Freeman
5−-- License : MIT (http://opensource.org/licenses/MIT)
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | A replacement for WriterT IO which uses mutable references.
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE FlexibleInstances #-}
16−{-# LANGUAGE MultiParamTypeClasses #-}
17−{-# LANGUAGE TypeFamilies #-}
18−
19−module Control.Monad.Logger where
20−
21−import Prelude ()
22−import Prelude.Compat
23−
24−import Data.IORef
25−
26−import Control.Monad (ap)
27−import Control.Monad.IO.Class
28−import Control.Monad.Writer.Class
29−import Control.Monad.Base (MonadBase(..))
30−import Control.Monad.Trans.Control (MonadBaseControl(..))
31−
32−-- | A replacement for WriterT IO which uses mutable references.
33−data Logger w a = Logger { runLogger :: IORef w -> IO a }
34−
35−-- | Run a Logger computation, starting with an empty log.
36−runLogger' :: (Monoid w) => Logger w a -> IO (a, w)
37−runLogger' l = do
38− r <- newIORef mempty
39− a <- runLogger l r
40− w <- readIORef r
41− return (a, w)
42−
43−instance Functor (Logger w) where
44− fmap f (Logger l) = Logger $ \r -> fmap f (l r)
45−
46−instance (Monoid w) => Applicative (Logger w) where
47− pure = Logger . const . pure
48− (<*>) = ap
49−
50−instance (Monoid w) => Monad (Logger w) where
51− return = pure
52− Logger l >>= f = Logger $ \r -> l r >>= \a -> runLogger (f a) r
53−
54−instance (Monoid w) => MonadIO (Logger w) where
55− liftIO = Logger . const
56−
57−instance (Monoid w) => MonadWriter w (Logger w) where
58− tell w = Logger $ \r -> atomicModifyIORef' r $ \w' -> (mappend w' w, ())
59− listen l = Logger $ \r -> do
60− (a, w) <- liftIO (runLogger' l)
61− atomicModifyIORef' r $ \w' -> (mappend w' w, (a, w))
62− pass l = Logger $ \r -> do
63− ((a, f), w) <- liftIO (runLogger' l)
64− atomicModifyIORef' r $ \w' -> (mappend w' (f w), a)
65−
66−instance (Monoid w) => MonadBase IO (Logger w) where
67− liftBase = liftIO
68−
69−instance (Monoid w) => MonadBaseControl IO (Logger w) where
70− type StM (Logger w) a = a
71− liftBaseWith f = Logger $ \r -> liftBaseWith $ \q -> f (q . flip runLogger r)
72− restoreM = return
src/Control/Monad/Supply.hsdeleted−45
@@ -1,45 +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 Prelude ()
21−import Prelude.Compat
22−
23−import Data.Functor.Identity
24−
25−import Control.Monad.State
26−import Control.Monad.Error.Class (MonadError(..))
27−import Control.Monad.Reader
28−import Control.Monad.Writer
29−
30−newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }
31− deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r)
32−
33−runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)
34−runSupplyT n = flip runStateT n . unSupplyT
35−
36−evalSupplyT :: (Functor m) => Integer -> SupplyT m a -> m a
37−evalSupplyT n = fmap fst . runSupplyT n
38−
39−type Supply = SupplyT Identity
40−
41−runSupply :: Integer -> Supply a -> (a, Integer)
42−runSupply n = runIdentity . runSupplyT n
43−
44−evalSupply :: Integer -> Supply a -> a
45−evalSupply n = runIdentity . evalSupplyT n
src/Control/Monad/Supply/Class.hsdeleted−24
@@ -1,24 +0,0 @@
1−{-# LANGUAGE MultiParamTypeClasses #-}
2−
3−-- |
4−-- A class for monads supporting a supply of fresh names
5−--
6−module Control.Monad.Supply.Class where
7−
8−import Control.Monad.Supply
9−import Control.Monad.State
10−
11−class (Monad m) => MonadSupply m where
12− fresh :: m Integer
13−
14−instance (Monad m) => MonadSupply (SupplyT m) where
15− fresh = SupplyT $ do
16− n <- get
17− put (n + 1)
18− return n
19−
20−instance (MonadSupply m) => MonadSupply (StateT s m) where
21− fresh = lift fresh
22−
23−freshName :: (MonadSupply m) => m String
24−freshName = liftM (('$' :) . show) fresh
src/Language/PureScript.hsdeleted−48
@@ -1,48 +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 FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−
19−module Language.PureScript
20− ( module P
21− , version
22− ) where
23−
24−import Data.Version (Version)
25−
26−import Language.PureScript.AST as P
27−import Language.PureScript.Crash as P
28−import Language.PureScript.Comments as P
29−import Language.PureScript.Environment as P
30−import Language.PureScript.Errors as P hiding (indent)
31−import Language.PureScript.Kinds as P
32−import Language.PureScript.Linter as P
33−import Language.PureScript.Make as P
34−import Language.PureScript.ModuleDependencies as P
35−import Language.PureScript.Names as P
36−import Language.PureScript.Options as P
37−import Language.PureScript.Parser as P
38−import Language.PureScript.Pretty as P
39−import Language.PureScript.Renamer as P
40−import Language.PureScript.Sugar as P
41−import Control.Monad.Supply as P
42−import Language.PureScript.TypeChecker as P
43−import Language.PureScript.Types as P
44−
45−import qualified Paths_purescript as Paths
46−
47−version :: Version
48−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−81
@@ -1,81 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−
3−-- |
4−-- Case binders
5−--
6−module Language.PureScript.AST.Binders where
7−
8−import qualified Data.Data as D
9−
10−import Language.PureScript.AST.SourcePos
11−import Language.PureScript.Names
12−import Language.PureScript.Comments
13−import Language.PureScript.Types
14−
15−-- |
16−-- Data type for binders
17−--
18−data Binder
19− -- |
20− -- Wildcard binder
21− --
22− = NullBinder
23− -- |
24− -- A binder which matches a boolean literal
25− --
26− | BooleanBinder Bool
27− -- |
28− -- A binder which matches a string literal
29− --
30− | StringBinder String
31− -- |
32− -- A binder which matches a character literal
33− --
34− | CharBinder Char
35− -- |
36− -- A binder which matches a numeric literal
37− --
38− | NumberBinder (Either Integer Double)
39− -- |
40− -- A binder which binds an identifier
41− --
42− | VarBinder Ident
43− -- |
44− -- A binder which matches a data constructor
45− --
46− | ConstructorBinder (Qualified (ProperName 'ConstructorName)) [Binder]
47− -- |
48− -- A binder which matches a record and binds its properties
49− --
50− | ObjectBinder [(String, Binder)]
51− -- |
52− -- A binder which matches an array and binds its elements
53− --
54− | ArrayBinder [Binder]
55− -- |
56− -- A binder which binds its input to an identifier
57− --
58− | NamedBinder Ident Binder
59− -- |
60− -- A binder with source position information
61− --
62− | PositionedBinder SourceSpan [Comment] Binder
63− -- |
64− -- A binder with a type annotation
65− --
66− | TypedBinder Type Binder deriving (Show, Read, Eq, D.Data, D.Typeable)
67−
68−-- |
69−-- Collect all names introduced in binders in an expression
70−--
71−binderNames :: Binder -> [Ident]
72−binderNames = go []
73− where
74− go ns (VarBinder name) = name : ns
75− go ns (ConstructorBinder _ bs) = foldl go ns bs
76− go ns (ObjectBinder bs) = foldl go ns (map snd bs)
77− go ns (ArrayBinder bs) = foldl go ns bs
78− go ns (NamedBinder name b) = go (name : ns) b
79− go ns (PositionedBinder _ _ b) = go ns b
80− go ns (TypedBinder _ b) = go ns b
81− go ns _ = ns
src/Language/PureScript/AST/Declarations.hsdeleted−473
@@ -1,473 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−{-# LANGUAGE LambdaCase #-}
5−
6−-- |
7−-- Data types for modules and declarations
8−--
9−module Language.PureScript.AST.Declarations where
10−
11−import Prelude ()
12−import Prelude.Compat
13−
14−import Data.Aeson.TH
15−import Data.List (nub, (\\))
16−import Data.Maybe (mapMaybe)
17−
18−import qualified Data.Data as D
19−import qualified Data.Map as M
20−
21−import Control.Monad.Identity
22−
23−import Language.PureScript.AST.Binders
24−import Language.PureScript.AST.Operators
25−import Language.PureScript.AST.SourcePos
26−import Language.PureScript.Types
27−import Language.PureScript.Names
28−import Language.PureScript.Kinds
29−import Language.PureScript.TypeClassDictionaries
30−import Language.PureScript.Comments
31−import Language.PureScript.Environment
32−
33−-- |
34−-- A module declaration, consisting of comments about the module, a module name,
35−-- a list of declarations, and a list of the declarations that are
36−-- explicitly exported. If the export list is Nothing, everything is exported.
37−--
38−data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, Read, D.Data, D.Typeable)
39−
40−-- | Return a module's name.
41−getModuleName :: Module -> ModuleName
42−getModuleName (Module _ _ name _ _) = name
43−
44−-- |
45−-- Add an import declaration for a module if it does not already explicitly import it.
46−--
47−addDefaultImport :: ModuleName -> Module -> Module
48−addDefaultImport toImport m@(Module ss coms mn decls exps) =
49− if isExistingImport `any` decls || mn == toImport then m
50− else Module ss coms mn (ImportDeclaration toImport Implicit Nothing False : decls) exps
51− where
52− isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True
53− isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d
54− isExistingImport _ = False
55−
56−-- |
57−-- An item in a list of explicit imports or exports
58−--
59−data DeclarationRef
60− -- |
61− -- A type constructor with data constructors
62− --
63− = TypeRef (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])
64− -- |
65− -- A value
66− --
67− | ValueRef Ident
68− -- |
69− -- A type class
70− --
71− | TypeClassRef (ProperName 'ClassName)
72− -- |
73− -- A type class instance, created during typeclass desugaring (name, class name, instance types)
74− --
75− | TypeInstanceRef Ident
76− -- |
77− -- A module, in its entirety
78− --
79− | ModuleRef ModuleName
80− -- |
81− -- An unspecified ProperName ref. This will be replaced with a TypeClassRef
82− -- or TypeRef during name desugaring.
83− | ProperRef String
84− -- |
85− -- A declaration reference with source position information
86− --
87− | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
88− deriving (Show, Read, D.Data, D.Typeable)
89−
90−instance Eq DeclarationRef where
91− (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
92− (ValueRef name) == (ValueRef name') = name == name'
93− (TypeClassRef name) == (TypeClassRef name') = name == name'
94− (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
95− (ModuleRef name) == (ModuleRef name') = name == name'
96− (ProperRef name) == (ProperRef name') = name == name'
97− (PositionedDeclarationRef _ _ r) == r' = r == r'
98− r == (PositionedDeclarationRef _ _ r') = r == r'
99− _ == _ = False
100−
101−isModuleRef :: DeclarationRef -> Bool
102−isModuleRef (PositionedDeclarationRef _ _ r) = isModuleRef r
103−isModuleRef (ModuleRef _) = True
104−isModuleRef _ = False
105−
106−-- |
107−-- Finds duplicate values in a list of declaration refs. The returned values
108−-- are the duplicate refs with data constructors elided, and then a separate
109−-- list of duplicate data constructors.
110−--
111−findDuplicateRefs :: [DeclarationRef] -> ([DeclarationRef], [ProperName 'ConstructorName])
112−findDuplicateRefs refs =
113− let positionless = stripPosInfo `map` refs
114− simplified = simplifyTypeRefs `map` positionless
115− dupeRefs = nub $ simplified \\ nub simplified
116− dupeCtors = concat $ flip mapMaybe positionless $ \case
117− TypeRef _ (Just dctors) ->
118− let dupes = dctors \\ nub dctors
119− in if null dupes then Nothing else Just dupes
120− _ -> Nothing
121− in (dupeRefs, dupeCtors)
122− where
123− stripPosInfo (PositionedDeclarationRef _ _ ref) = stripPosInfo ref
124− stripPosInfo other = other
125− simplifyTypeRefs (TypeRef pn _) = TypeRef pn Nothing
126− simplifyTypeRefs other = other
127−
128−-- |
129−-- The data type which specifies type of import declaration
130−--
131−data ImportDeclarationType
132− -- |
133− -- An import with no explicit list: `import M`.
134− --
135− = Implicit
136− -- |
137− -- An import with an explicit list of references to import: `import M (foo)`
138− --
139− | Explicit [DeclarationRef]
140− -- |
141− -- An import with a list of references to hide: `import M hiding (foo)`
142− --
143− | Hiding [DeclarationRef]
144− deriving (Eq, Show, Read, D.Data, D.Typeable)
145−
146−isImplicit :: ImportDeclarationType -> Bool
147−isImplicit Implicit = True
148−isImplicit _ = False
149−
150−-- |
151−-- The data type of declarations
152−--
153−data Declaration
154− -- |
155− -- A data type declaration (data or newtype, name, arguments, data constructors)
156− --
157− = DataDeclaration DataDeclType (ProperName 'TypeName) [(String, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]
158− -- |
159− -- A minimal mutually recursive set of data type declarations
160− --
161− | DataBindingGroupDeclaration [Declaration]
162− -- |
163− -- A type synonym declaration (name, arguments, type)
164− --
165− | TypeSynonymDeclaration (ProperName 'TypeName) [(String, Maybe Kind)] Type
166− -- |
167− -- A type declaration for a value (name, ty)
168− --
169− | TypeDeclaration Ident Type
170− -- |
171− -- A value declaration (name, top-level binders, optional guard, value)
172− --
173− | ValueDeclaration Ident NameKind [Binder] (Either [(Guard, Expr)] Expr)
174− -- |
175− -- A minimal mutually recursive set of value declarations
176− --
177− | BindingGroupDeclaration [(Ident, NameKind, Expr)]
178− -- |
179− -- A foreign import declaration (name, type)
180− --
181− | ExternDeclaration Ident Type
182− -- |
183− -- A data type foreign import (name, kind)
184− --
185− | ExternDataDeclaration (ProperName 'TypeName) Kind
186− -- |
187− -- A fixity declaration (fixity data, operator name, value the operator is an alias for)
188− --
189− | FixityDeclaration Fixity String (Maybe (Qualified Ident))
190− -- |
191− -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
192− -- TODO: also a boolean specifying whether the old `qualified` syntax was used, so a warning can be raised in desugaring (remove for 0.9)
193− --
194− | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName) Bool
195− -- |
196− -- A type class declaration (name, argument, implies, member declarations)
197− --
198− | TypeClassDeclaration (ProperName 'ClassName) [(String, Maybe Kind)] [Constraint] [Declaration]
199− -- |
200− -- A type instance declaration (name, dependencies, class name, instance types, member
201− -- declarations)
202− --
203− | TypeInstanceDeclaration Ident [Constraint] (Qualified (ProperName 'ClassName)) [Type] TypeInstanceBody
204− -- |
205− -- A declaration with source position information
206− --
207− | PositionedDeclaration SourceSpan [Comment] Declaration
208− deriving (Show, Read, D.Data, D.Typeable)
209−
210−-- | The members of a type class instance declaration
211−data TypeInstanceBody
212− -- | This is a derived instance
213− = DerivedInstance
214− -- | This is a regular (explicit) instance
215− | ExplicitInstance [Declaration]
216− deriving (Show, Read, D.Data, D.Typeable)
217−
218−mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody
219−mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)
220−
221−-- | A traversal for TypeInstanceBody
222−traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody
223−traverseTypeInstanceBody _ DerivedInstance = pure DerivedInstance
224−traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds
225−
226−-- |
227−-- Test if a declaration is a value declaration
228−--
229−isValueDecl :: Declaration -> Bool
230−isValueDecl ValueDeclaration{} = True
231−isValueDecl (PositionedDeclaration _ _ d) = isValueDecl d
232−isValueDecl _ = False
233−
234−-- |
235−-- Test if a declaration is a data type or type synonym declaration
236−--
237−isDataDecl :: Declaration -> Bool
238−isDataDecl DataDeclaration{} = True
239−isDataDecl TypeSynonymDeclaration{} = True
240−isDataDecl (PositionedDeclaration _ _ d) = isDataDecl d
241−isDataDecl _ = False
242−
243−-- |
244−-- Test if a declaration is a module import
245−--
246−isImportDecl :: Declaration -> Bool
247−isImportDecl ImportDeclaration{} = True
248−isImportDecl (PositionedDeclaration _ _ d) = isImportDecl d
249−isImportDecl _ = False
250−
251−-- |
252−-- Test if a declaration is a data type foreign import
253−--
254−isExternDataDecl :: Declaration -> Bool
255−isExternDataDecl ExternDataDeclaration{} = True
256−isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
257−isExternDataDecl _ = False
258−
259−-- |
260−-- Test if a declaration is a fixity declaration
261−--
262−isFixityDecl :: Declaration -> Bool
263−isFixityDecl FixityDeclaration{} = True
264−isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
265−isFixityDecl _ = False
266−
267−-- |
268−-- Test if a declaration is a foreign import
269−--
270−isExternDecl :: Declaration -> Bool
271−isExternDecl ExternDeclaration{} = True
272−isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
273−isExternDecl _ = False
274−
275−-- |
276−-- Test if a declaration is a type class instance declaration
277−--
278−isTypeClassInstanceDeclaration :: Declaration -> Bool
279−isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True
280−isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d
281−isTypeClassInstanceDeclaration _ = False
282−
283−-- |
284−-- Test if a declaration is a type class declaration
285−--
286−isTypeClassDeclaration :: Declaration -> Bool
287−isTypeClassDeclaration TypeClassDeclaration{} = True
288−isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d
289−isTypeClassDeclaration _ = False
290−
291−-- |
292−-- Recursively flatten data binding groups in the list of declarations
293−flattenDecls :: [Declaration] -> [Declaration]
294−flattenDecls = concatMap flattenOne
295− where flattenOne :: Declaration -> [Declaration]
296− flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls
297− flattenOne d = [d]
298−
299−-- |
300−-- A guard is just a boolean-valued expression that appears alongside a set of binders
301−--
302−type Guard = Expr
303−
304−-- |
305−-- Data type for expressions and terms
306−--
307−data Expr
308− -- |
309− -- A numeric literal
310− --
311− = NumericLiteral (Either Integer Double)
312− -- |
313− -- A string literal
314− --
315− | StringLiteral String
316− -- |
317− -- A character literal
318− --
319− | CharLiteral Char
320− -- |
321− -- A boolean literal
322− --
323− | BooleanLiteral Bool
324− -- |
325− -- A prefix -, will be desugared
326− --
327− | UnaryMinus Expr
328− -- |
329− -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
330− -- will be removed.
331− --
332− | BinaryNoParens Expr Expr Expr
333− -- |
334− -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor
335− -- will be removed.
336− --
337− | Parens Expr
338− -- |
339− -- Operator section. This will be removed during desugaring and replaced with a partially applied
340− -- operator or lambda to flip the arguments.
341− --
342− | OperatorSection Expr (Either Expr Expr)
343− -- |
344− -- An array literal
345− --
346− | ArrayLiteral [Expr]
347− -- |
348− -- An object literal
349− --
350− | ObjectLiteral [(String, Expr)]
351− -- |
352− -- An object constructor (object literal with underscores). This will be removed during
353− -- desugaring and expanded into a lambda that returns an object literal.
354− --
355− | ObjectConstructor [(String, Maybe Expr)]
356− -- |
357− -- An object property getter (e.g. `_.x`). This will be removed during
358− -- desugaring and expanded into a lambda that reads a property from an object.
359− --
360− | ObjectGetter String
361− -- |
362− -- An record property accessor expression
363− --
364− | Accessor String Expr
365− -- |
366− -- Partial record update
367− --
368− | ObjectUpdate Expr [(String, Expr)]
369− -- |
370− -- Partial record updater. This will be removed during desugaring and
371− -- expanded into a lambda that returns an object update.
372− --
373− | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]
374− -- |
375− -- Function introduction
376− --
377− | Abs (Either Ident Binder) Expr
378− -- |
379− -- Function application
380− --
381− | App Expr Expr
382− -- |
383− -- Variable
384− --
385− | Var (Qualified Ident)
386− -- |
387− -- Conditional (if-then-else expression)
388− --
389− | IfThenElse Expr Expr Expr
390− -- |
391− -- A data constructor
392− --
393− | Constructor (Qualified (ProperName 'ConstructorName))
394− -- |
395− -- A case expression. During the case expansion phase of desugaring, top-level binders will get
396− -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
397− --
398− | Case [Expr] [CaseAlternative]
399− -- |
400− -- A value with a type annotation
401− --
402− | TypedValue Bool Expr Type
403− -- |
404− -- A let binding
405− --
406− | Let [Declaration] Expr
407− -- |
408− -- A do-notation block
409− --
410− | Do [DoNotationElement]
411− -- |
412− -- An application of a typeclass dictionary constructor. The value should be
413− -- an ObjectLiteral.
414− --
415− | TypeClassDictionaryConstructorApp (Qualified (ProperName 'ClassName)) Expr
416− -- |
417− -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
418− -- placeholders will be replaced with actual expressions representing type classes dictionaries which
419− -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
420− -- at superclass implementations when searching for a dictionary, the type class name and
421− -- instance type, and the type class dictionaries in scope.
422− --
423− | TypeClassDictionary Constraint (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))
424− -- |
425− -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
426− --
427− | TypeClassDictionaryAccessor (Qualified (ProperName 'ClassName)) Ident
428− -- |
429− -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
430− --
431− | SuperClassDictionary (Qualified (ProperName 'ClassName)) [Type]
432− -- |
433− -- A value with source position information
434− --
435− | PositionedValue SourceSpan [Comment] Expr deriving (Show, Read, D.Data, D.Typeable)
436−
437−-- |
438−-- An alternative in a case statement
439−--
440−data CaseAlternative = CaseAlternative
441− { -- |
442− -- A collection of binders with which to match the inputs
443− --
444− caseAlternativeBinders :: [Binder]
445− -- |
446− -- The result expression or a collect of guarded expressions
447− --
448− , caseAlternativeResult :: Either [(Guard, Expr)] Expr
449− } deriving (Show, Read, D.Data, D.Typeable)
450−
451−-- |
452−-- A statement in a do-notation block
453−--
454−data DoNotationElement
455− -- |
456− -- A monadic value without a binder
457− --
458− = DoNotationValue Expr
459− -- |
460− -- A monadic value with a binder
461− --
462− | DoNotationBind Binder Expr
463− -- |
464− -- A let statement, i.e. a pure value with a binder
465− --
466− | DoNotationLet [Declaration]
467− -- |
468− -- A do notation element with source position information
469− --
470− | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement deriving (Show, Read, D.Data, D.Typeable)
471−
472−$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)
473−$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)
src/Language/PureScript/AST/Exported.hsdeleted−154
@@ -1,154 +0,0 @@
1−module Language.PureScript.AST.Exported
2− ( exportedDeclarations
3− , isExported
4− ) where
5−
6−import Control.Category ((>>>))
7−import Data.Maybe (mapMaybe)
8−
9−import Language.PureScript.AST.Declarations
10−import Language.PureScript.Types
11−import Language.PureScript.Names
12−
13−-- |
14−-- Return a list of all declarations which are exported from a module.
15−-- This function descends into data declarations to filter out unexported
16−-- data constructors, and also filters out type instance declarations if
17−-- they refer to classes or types which are not themselves exported.
18−--
19−-- Note that this function assumes that the module has already had its imports
20−-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
21−-- produce incorrect results if this is not the case - for example, type class
22−-- instances will be incorrectly removed in some cases.
23−--
24−exportedDeclarations :: Module -> [Declaration]
25−exportedDeclarations (Module _ _ mn decls exps) = go decls
26− where
27− go = flattenDecls
28− >>> filter (isExported exps)
29− >>> map (filterDataConstructors exps)
30− >>> filterInstances mn exps
31−
32−-- |
33−-- Filter out all data constructors from a declaration which are not exported.
34−-- If the supplied declaration is not a data declaration, this function returns
35−-- it unchanged.
36−--
37−filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
38−filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =
39− DataDeclaration dType tyName tyArgs $
40− filter (isDctorExported tyName exps . fst) dctors
41−filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =
42− PositionedDeclaration srcSpan coms (filterDataConstructors exps d)
43−filterDataConstructors _ other = other
44−
45−-- |
46−-- Filter out all the type instances from a list of declarations which
47−-- reference a type or type class which is both local and not exported.
48−--
49−-- Note that this function assumes that the module has already had its imports
50−-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
51−-- produce incorrect results if this is not the case - for example, type class
52−-- instances will be incorrectly removed in some cases.
53−--
54−filterInstances
55− :: ModuleName
56− -> Maybe [DeclarationRef]
57− -> [Declaration]
58− -> [Declaration]
59−filterInstances _ Nothing = id
60−filterInstances mn (Just exps) =
61− let refs = Left `map` mapMaybe typeClassName exps
62− ++ Right `map` mapMaybe typeName exps
63− in filter (all (visibleOutside refs) . typeInstanceConstituents)
64− where
65− -- Given a Qualified ProperName, and a list of all exported types and type
66− -- classes, returns whether the supplied Qualified ProperName is visible
67− -- outside this module. This is true if one of the following hold:
68− --
69− -- * the name is defined in the same module and is exported,
70− -- * the name is defined in a different module (and must be exported from
71− -- that module; the code would fail to compile otherwise).
72− visibleOutside
73− :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
74− -> Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))
75− -> Bool
76− visibleOutside refs q
77− | either checkQual checkQual q = True
78− | otherwise = either (Left . disqualify) (Right . disqualify) q `elem` refs
79−
80− -- Check that a qualified name is qualified for a different module
81− checkQual :: Qualified a -> Bool
82− checkQual q = isQualified q && not (isQualifiedWith mn q)
83−
84− typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)
85− typeName (TypeRef n _) = Just n
86− typeName (PositionedDeclarationRef _ _ r) = typeName r
87− typeName _ = Nothing
88−
89− typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)
90− typeClassName (TypeClassRef n) = Just n
91− typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r
92− typeClassName _ = Nothing
93−
94−-- |
95−-- Get all type and type class names referenced by a type instance declaration.
96−--
97−typeInstanceConstituents :: Declaration -> [Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))]
98−typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =
99− Left className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
100− where
101−
102− fromConstraint (name, tys') = Left name : concatMap fromType tys'
103− fromType = everythingOnTypes (++) go
104−
105− -- Note that type synonyms are disallowed in instance declarations, so
106− -- we don't need to handle them here.
107− go (TypeConstructor n) = [Right n]
108− go (ConstrainedType cs _) = concatMap fromConstraint cs
109− go _ = []
110−
111−typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d
112−typeInstanceConstituents _ = []
113−
114−
115−-- |
116−-- Test if a declaration is exported, given a module's export list. Note that
117−-- this function does not account for type instance declarations of
118−-- non-exported types, or non-exported data constructors. Therefore, you should
119−-- prefer 'exportedDeclarations' to this function, where possible.
120−--
121−isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
122−isExported Nothing _ = True
123−isExported _ TypeInstanceDeclaration{} = True
124−isExported exps (PositionedDeclaration _ _ d) = isExported exps d
125−isExported (Just exps) decl = any (matches decl) exps
126− where
127− matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
128− matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
129− matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'
130− matches (FixityDeclaration _ name _) (ValueRef ident') = name == runIdent ident'
131− matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
132− matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
133− matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
134− matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
135−
136− matches (DataDeclaration _ ident _ _) (ProperRef ident') = runProperName ident == ident'
137− matches (TypeClassDeclaration ident _ _ _) (ProperRef ident') = runProperName ident == ident'
138−
139− matches (PositionedDeclaration _ _ d) r = d `matches` r
140− matches d (PositionedDeclarationRef _ _ r) = d `matches` r
141− matches _ _ = False
142−
143−-- |
144−-- Test if a data constructor for a given type is exported, given a module's
145−-- export list. Prefer 'exportedDeclarations' to this function, where possible.
146−--
147−isDctorExported :: ProperName 'TypeName -> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
148−isDctorExported _ Nothing _ = True
149−isDctorExported ident (Just exps) ctor = test `any` exps
150− where
151− test (PositionedDeclarationRef _ _ d) = test d
152− test (TypeRef ident' Nothing) = ident == ident'
153− test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
154− test _ = False
src/Language/PureScript/AST/Operators.hsdeleted−62
@@ -1,62 +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 OverloadedStrings #-}
16−{-# LANGUAGE DeriveDataTypeable #-}
17−
18−module Language.PureScript.AST.Operators where
19−
20−import qualified Data.Data as D
21−import Data.Aeson ((.=))
22−import qualified Data.Aeson as A
23−
24−import Language.PureScript.Crash
25−
26−-- |
27−-- A precedence level for an infix operator
28−--
29−type Precedence = Integer
30−
31−-- |
32−-- Associativity for infix operators
33−--
34−data Associativity = Infixl | Infixr | Infix deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
35−
36−showAssoc :: Associativity -> String
37−showAssoc Infixl = "infixl"
38−showAssoc Infixr = "infixr"
39−showAssoc Infix = "infix"
40−
41−readAssoc :: String -> Associativity
42−readAssoc "infixl" = Infixl
43−readAssoc "infixr" = Infixr
44−readAssoc "infix" = Infix
45−readAssoc _ = internalError "readAssoc: no parse"
46−
47−instance A.ToJSON Associativity where
48− toJSON = A.toJSON . showAssoc
49−
50−instance A.FromJSON Associativity where
51− parseJSON = fmap readAssoc . A.parseJSON
52−
53−-- |
54−-- Fixity data for infix operators
55−--
56−data Fixity = Fixity Associativity Precedence deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
57−
58−instance A.ToJSON Fixity where
59− toJSON (Fixity associativity precedence) =
60− A.object [ "associativity" .= associativity
61− , "precedence" .= precedence
62− ]
src/Language/PureScript/AST/SourcePos.hsdeleted−96
@@ -1,96 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.SourcePos
4−-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5−-- License : MIT (http://opensource.org/licenses/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 #-}
16−{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE RecordWildCards #-}
18−{-# LANGUAGE OverloadedStrings #-}
19−
20−module Language.PureScript.AST.SourcePos where
21−
22−import Prelude ()
23−import Prelude.Compat
24−
25−import qualified Data.Data as D
26−import Data.Aeson ((.=), (.:))
27−import qualified Data.Aeson as A
28−
29−-- |
30−-- Source position information
31−--
32−data SourcePos = SourcePos
33− { -- |
34− -- Line number
35− --
36− sourcePosLine :: Int
37− -- |
38− -- Column number
39− --
40− , sourcePosColumn :: Int
41− } deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
42−
43−displaySourcePos :: SourcePos -> String
44−displaySourcePos sp =
45− "line " ++ show (sourcePosLine sp) ++
46− ", column " ++ show (sourcePosColumn sp)
47−
48−instance A.ToJSON SourcePos where
49− toJSON SourcePos{..} =
50− A.toJSON [sourcePosLine, sourcePosColumn]
51−
52−instance A.FromJSON SourcePos where
53− parseJSON arr = do
54− [line, col] <- A.parseJSON arr
55− return $ SourcePos line col
56−
57−data SourceSpan = SourceSpan
58− { -- |
59− -- Source name
60− --
61− spanName :: String
62− -- |
63− -- Start of the span
64− --
65− , spanStart :: SourcePos
66− -- End of the span
67− --
68− , spanEnd :: SourcePos
69− } deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
70−
71−displayStartEndPos :: SourceSpan -> String
72−displayStartEndPos sp =
73− displaySourcePos (spanStart sp) ++ " - " ++
74− displaySourcePos (spanEnd sp)
75−
76−displaySourceSpan :: SourceSpan -> String
77−displaySourceSpan sp =
78− spanName sp ++ " " ++
79− displayStartEndPos sp
80−
81−instance A.ToJSON SourceSpan where
82− toJSON SourceSpan{..} =
83− A.object [ "name" .= spanName
84− , "start" .= spanStart
85− , "end" .= spanEnd
86− ]
87−
88−instance A.FromJSON SourceSpan where
89− parseJSON = A.withObject "SourceSpan" $ \o ->
90− SourceSpan <$>
91− o .: "name" <*>
92− o .: "start" <*>
93− o .: "end"
94−
95−internalModuleSourceSpan :: String -> SourceSpan
96−internalModuleSourceSpan name = SourceSpan name (SourcePos 0 0) (SourcePos 0 0)
src/Language/PureScript/AST/Traversals.hsdeleted−517
@@ -1,517 +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 Prelude ()
18−import Prelude.Compat
19−
20−import Data.Maybe (mapMaybe)
21−import Data.List (mapAccumL)
22−import Data.Foldable (fold)
23−import qualified Data.Set as S
24−
25−import Control.Monad
26−import Control.Arrow ((***), (+++), second)
27−
28−import Language.PureScript.AST.Binders
29−import Language.PureScript.AST.Declarations
30−import Language.PureScript.Types
31−import Language.PureScript.Traversals
32−import Language.PureScript.Names
33−
34−everywhereOnValues :: (Declaration -> Declaration) ->
35− (Expr -> Expr) ->
36− (Binder -> Binder) ->
37− (Declaration -> Declaration, Expr -> Expr, Binder -> Binder)
38−everywhereOnValues f g h = (f', g', h')
39− where
40− f' :: Declaration -> Declaration
41− f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))
42− f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) ((map (g' *** g') +++ g') val))
43− f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
44− f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))
45− f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (mapTypeInstanceBody (map f') ds))
46− f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))
47− f' other = f other
48−
49− g' :: Expr -> Expr
50− g' (UnaryMinus v) = g (UnaryMinus (g' v))
51− g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
52− g' (Parens v) = g (Parens (g' v))
53− g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))
54− g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))
55− g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))
56− g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))
57− g' (ObjectConstructor vs) = g (ObjectConstructor (map (second (fmap g')) vs))
58− g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
59− g' (Accessor prop v) = g (Accessor prop (g' v))
60− g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))
61− g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))
62− g' (Abs name v) = g (Abs name (g' v))
63− g' (App v1 v2) = g (App (g' v1) (g' v2))
64− g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))
65− g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))
66− g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
67− g' (Let ds v) = g (Let (map f' ds) (g' v))
68− g' (Do es) = g (Do (map handleDoNotationElement es))
69− g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))
70− g' other = g other
71−
72− h' :: Binder -> Binder
73− h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))
74− h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))
75− h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))
76− h' (NamedBinder name b) = h (NamedBinder name (h' b))
77− h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
78− h' (TypedBinder t b) = h (TypedBinder t (h' b))
79− h' other = h other
80−
81− handleCaseAlternative :: CaseAlternative -> CaseAlternative
82− handleCaseAlternative ca =
83− ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
84− , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
85− }
86−
87− handleDoNotationElement :: DoNotationElement -> DoNotationElement
88− handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)
89− handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)
90− handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)
91− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)
92−
93−everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>
94− (Declaration -> m Declaration) ->
95− (Expr -> m Expr) ->
96− (Binder -> m Binder) ->
97− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
98−everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
99− where
100− f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds
101− f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h' <=< h) bs <*> eitherM (traverse (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
102− f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
103− f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> traverse (f' <=< f) ds
104− f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds
105− f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')
106− f' other = f other
107−
108− g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
109− g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
110− g' (Parens v) = Parens <$> (g v >>= g')
111− g' (OperatorSection op (Left v)) = OperatorSection <$> (g op >>= g') <*> (Left <$> (g v >>= g'))
112− g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))
113− g' (ArrayLiteral vs) = ArrayLiteral <$> traverse (g' <=< g) vs
114− g' (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g' <=< g)) vs
115− g' (ObjectConstructor vs) = ObjectConstructor <$> traverse (sndM $ maybeM (g' <=< g)) vs
116− g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
117− g' (Accessor prop v) = Accessor prop <$> (g v >>= g')
118− g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> traverse (sndM (g' <=< g)) vs
119− g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> traverse (sndM $ maybeM (g' <=< g)) vs
120− g' (Abs name v) = Abs name <$> (g v >>= g')
121− g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')
122− g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')
123− g' (Case vs alts) = Case <$> traverse (g' <=< g) vs <*> traverse handleCaseAlternative alts
124− g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
125− g' (Let ds v) = Let <$> traverse (f' <=< f) ds <*> (g v >>= g')
126− g' (Do es) = Do <$> traverse handleDoNotationElement es
127− g' (PositionedValue pos com v) = PositionedValue pos com <$> (g v >>= g')
128− g' other = g other
129−
130− h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> traverse (h' <=< h) bs
131− h' (ObjectBinder bs) = ObjectBinder <$> traverse (sndM (h' <=< h)) bs
132− h' (ArrayBinder bs) = ArrayBinder <$> traverse (h' <=< h) bs
133− h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
134− h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
135− h' (TypedBinder t b) = TypedBinder t <$> (h b >>= h')
136− h' other = h other
137−
138− handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> traverse (h' <=< h) bs
139− <*> eitherM (traverse (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
140−
141− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v
142− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v
143− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> traverse (f' <=< f) ds
144− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
145−
146−everywhereOnValuesM :: (Functor m, Applicative m, Monad m) =>
147− (Declaration -> m Declaration) ->
148− (Expr -> m Expr) ->
149− (Binder -> m Binder) ->
150− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
151−everywhereOnValuesM f g h = (f', g', h')
152− where
153− f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f
154− f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> traverse h' bs <*> eitherM (traverse (pairM g' g')) g' val) >>= f
155− f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f
156− f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> traverse f' ds) >>= f
157− f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse f') ds) >>= f
158− f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f
159− f' other = f other
160−
161− g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
162− g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
163− g' (Parens v) = (Parens <$> g' v) >>= g
164− g' (OperatorSection op (Left v)) = (OperatorSection <$> g' op <*> (Left <$> g' v)) >>= g
165− g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g
166− g' (ArrayLiteral vs) = (ArrayLiteral <$> traverse g' vs) >>= g
167− g' (ObjectLiteral vs) = (ObjectLiteral <$> traverse (sndM g') vs) >>= g
168− g' (ObjectConstructor vs) = (ObjectConstructor <$> traverse (sndM $ maybeM g') vs) >>= g
169− g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
170− g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g
171− g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> traverse (sndM g') vs) >>= g
172− g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> traverse (sndM $ maybeM g') vs) >>= g
173− g' (Abs name v) = (Abs name <$> g' v) >>= g
174− g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g
175− g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g
176− g' (Case vs alts) = (Case <$> traverse g' vs <*> traverse handleCaseAlternative alts) >>= g
177− g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
178− g' (Let ds v) = (Let <$> traverse f' ds <*> g' v) >>= g
179− g' (Do es) = (Do <$> traverse handleDoNotationElement es) >>= g
180− g' (PositionedValue pos com v) = (PositionedValue pos com <$> g' v) >>= g
181− g' other = g other
182−
183− h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> traverse h' bs) >>= h
184− h' (ObjectBinder bs) = (ObjectBinder <$> traverse (sndM h') bs) >>= h
185− h' (ArrayBinder bs) = (ArrayBinder <$> traverse h' bs) >>= h
186− h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
187− h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
188− h' (TypedBinder t b) = (TypedBinder t <$> h' b) >>= h
189− h' other = h other
190−
191− handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> traverse h' bs
192− <*> eitherM (traverse (pairM g' g')) g' val
193−
194− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v
195− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v
196− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> traverse f' ds
197− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
198−
199−everythingOnValues :: (r -> r -> r) ->
200− (Declaration -> r) ->
201− (Expr -> r) ->
202− (Binder -> r) ->
203− (CaseAlternative -> r) ->
204− (DoNotationElement -> r) ->
205− (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
206−everythingOnValues (<>) f g h i j = (f', g', h', i', j')
207− where
208− f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)
209− f' d@(ValueDeclaration _ _ bs (Right val)) = foldl (<>) (f d) (map h' bs) <> g' val
210− f' d@(ValueDeclaration _ _ bs (Left gs)) = foldl (<>) (f d) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
211− f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)
212− f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)
213− f' d@(TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (map f' ds)
214− f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1
215− f' d = f d
216−
217− g' v@(UnaryMinus v1) = g v <> g' v1
218− g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2
219− g' v@(Parens v1) = g v <> g' v1
220− g' v@(OperatorSection op (Left v1)) = g v <> g' op <> g' v1
221− g' v@(OperatorSection op (Right v1)) = g v <> g' op <> g' v1
222− g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)
223− g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)
224− g' v@(ObjectConstructor vs) = foldl (<>) (g v) (map g' (mapMaybe snd vs))
225− g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
226− g' v@(Accessor _ v1) = g v <> g' v1
227− g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
228− g' v@(ObjectUpdater obj vs) = foldl (<>) (maybe (g v) (\x -> g v <> g' x) obj) (map g' (mapMaybe snd vs))
229− g' v@(Abs _ v1) = g v <> g' v1
230− g' v@(App v1 v2) = g v <> g' v1 <> g' v2
231− g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3
232− g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
233− g' v@(TypedValue _ v1 _) = g v <> g' v1
234− g' v@(Let ds v1) = foldl (<>) (g v) (map f' ds) <> g' v1
235− g' v@(Do es) = foldl (<>) (g v) (map j' es)
236− g' v@(PositionedValue _ _ v1) = g v <> g' v1
237− g' v = g v
238−
239− h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)
240− h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)
241− h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)
242− h' b@(NamedBinder _ b1) = h b <> h' b1
243− h' b@(PositionedBinder _ _ b1) = h b <> h' b1
244− h' b@(TypedBinder _ b1) = h b <> h' b1
245− h' b = h b
246−
247− i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
248− i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
249−
250− j' e@(DoNotationValue v) = j e <> g' v
251− j' e@(DoNotationBind b v) = j e <> h' b <> g' v
252− j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)
253− j' e@(PositionedDoNotationElement _ _ e1) = j e <> j' e1
254−
255−everythingWithContextOnValues ::
256− s ->
257− r ->
258− (r -> r -> r) ->
259− (s -> Declaration -> (s, r)) ->
260− (s -> Expr -> (s, r)) ->
261− (s -> Binder -> (s, r)) ->
262− (s -> CaseAlternative -> (s, r)) ->
263− (s -> DoNotationElement -> (s, r)) ->
264− ( Declaration -> r
265− , Expr -> r
266− , Binder -> r
267− , CaseAlternative -> r
268− , DoNotationElement -> r)
269−everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
270− where
271− f'' s d = let (s', r) = f s d in r <> f' s' d
272−
273− f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (map (f'' s) ds)
274− f' s (ValueDeclaration _ _ bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
275− f' s (ValueDeclaration _ _ bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
276− f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)
277− f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
278− f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (map (f'' s) ds)
279− f' s (PositionedDeclaration _ _ d1) = f'' s d1
280− f' _ _ = r0
281−
282− g'' s v = let (s', r) = g s v in r <> g' s' v
283−
284− g' s (UnaryMinus v1) = g'' s v1
285− g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
286− g' s (Parens v1) = g'' s v1
287− g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v
288− g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v
289− g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)
290− g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)
291− g' s (ObjectConstructor vs) = foldl (<>) r0 (map (g'' s) (mapMaybe snd vs))
292− g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
293− g' s (Accessor _ v1) = g'' s v1
294− g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)
295− g' s (ObjectUpdater obj vs) = foldl (<>) (maybe r0 (g'' s) obj) (map (g'' s) (mapMaybe snd vs))
296− g' s (Abs _ v1) = g'' s v1
297− g' s (App v1 v2) = g'' s v1 <> g'' s v2
298− g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
299− g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (map (g'' s) vs)) (map (i'' s) alts)
300− g' s (TypedValue _ v1 _) = g'' s v1
301− g' s (Let ds v1) = foldl (<>) r0 (map (f'' s) ds) <> g'' s v1
302− g' s (Do es) = foldl (<>) r0 (map (j'' s) es)
303− g' s (PositionedValue _ _ v1) = g'' s v1
304− g' _ _ = r0
305−
306− h'' s b = let (s', r) = h s b in r <> h' s' b
307−
308− h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)
309− h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)
310− h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
311− h' s (NamedBinder _ b1) = h'' s b1
312− h' s (PositionedBinder _ _ b1) = h'' s b1
313− h' s (TypedBinder _ b1) = h'' s b1
314− h' _ _ = r0
315−
316− i'' s ca = let (s', r) = i s ca in r <> i' s' ca
317−
318− i' s (CaseAlternative bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
319− i' s (CaseAlternative bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
320−
321− j'' s e = let (s', r) = j s e in r <> j' s' e
322−
323− j' s (DoNotationValue v) = g'' s v
324− j' s (DoNotationBind b v) = h'' s b <> g'' s v
325− j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
326− j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
327−
328−everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>
329− s ->
330− (s -> Declaration -> m (s, Declaration)) ->
331− (s -> Expr -> m (s, Expr)) ->
332− (s -> Binder -> m (s, Binder)) ->
333− (s -> CaseAlternative -> m (s, CaseAlternative)) ->
334− (s -> DoNotationElement -> m (s, DoNotationElement)) ->
335− ( Declaration -> m Declaration
336− , Expr -> m Expr
337− , Binder -> m Binder
338− , CaseAlternative -> m CaseAlternative
339− , DoNotationElement -> m DoNotationElement)
340−everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
341− where
342− f'' s = uncurry f' <=< f s
343−
344− f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds
345− f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h'' s) bs <*> eitherM (traverse (pairM (g'' s) (g'' s))) (g'' s) val
346− f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds
347− f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> traverse (f'' s) ds
348− f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds
349− f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1
350− f' _ other = return other
351−
352− g'' s = uncurry g' <=< g s
353−
354− g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
355− g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
356− g' s (Parens v) = Parens <$> g'' s v
357− g' s (OperatorSection op (Left v)) = OperatorSection <$> g'' s op <*> (Left <$> g'' s v)
358− g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)
359− g' s (ArrayLiteral vs) = ArrayLiteral <$> traverse (g'' s) vs
360− g' s (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g'' s)) vs
361− g' s (ObjectConstructor vs) = ObjectConstructor <$> traverse (sndM $ maybeM (g'' s)) vs
362− g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v
363− g' s (Accessor prop v) = Accessor prop <$> g'' s v
364− g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> traverse (sndM (g'' s)) vs
365− g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> traverse (sndM $ maybeM (g'' s)) vs
366− g' s (Abs name v) = Abs name <$> g'' s v
367− g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
368− g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
369− g' s (Case vs alts) = Case <$> traverse (g'' s) vs <*> traverse (i'' s) alts
370− g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
371− g' s (Let ds v) = Let <$> traverse (f'' s) ds <*> g'' s v
372− g' s (Do es) = Do <$> traverse (j'' s) es
373− g' s (PositionedValue pos com v) = PositionedValue pos com <$> g'' s v
374− g' _ other = return other
375−
376− h'' s = uncurry h' <=< h s
377−
378− h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> traverse (h'' s) bs
379− h' s (ObjectBinder bs) = ObjectBinder <$> traverse (sndM (h'' s)) bs
380− h' s (ArrayBinder bs) = ArrayBinder <$> traverse (h'' s) bs
381− h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
382− h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
383− h' s (TypedBinder t b) = TypedBinder t <$> h'' s b
384− h' _ other = return other
385−
386− i'' s = uncurry i' <=< i s
387−
388− i' s (CaseAlternative bs val) = CaseAlternative <$> traverse (h'' s) bs <*> eitherM (traverse (pairM (g'' s) (g'' s))) (g'' s) val
389−
390− j'' s = uncurry j' <=< j s
391−
392− j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
393− j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
394− j' s (DoNotationLet ds) = DoNotationLet <$> traverse (f'' s) ds
395− j' s (PositionedDoNotationElement pos com e1) = PositionedDoNotationElement pos com <$> j'' s e1
396−
397−everythingWithScope ::
398− (Monoid r) =>
399− (S.Set Ident -> Declaration -> r) ->
400− (S.Set Ident -> Expr -> r) ->
401− (S.Set Ident -> Binder -> r) ->
402− (S.Set Ident -> CaseAlternative -> r) ->
403− (S.Set Ident -> DoNotationElement -> r) ->
404− ( S.Set Ident -> Declaration -> r
405− , S.Set Ident -> Expr -> r
406− , S.Set Ident -> Binder -> r
407− , S.Set Ident -> CaseAlternative -> r
408− , S.Set Ident -> DoNotationElement -> r)
409−everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
410− where
411− -- Avoid importing Data.Monoid and getting shadowed names above
412− (<>) = mappend
413−
414− f'' s a = f s a <> f' s a
415−
416− f' s (DataBindingGroupDeclaration ds) =
417− let s' = S.union s (S.fromList (mapMaybe getDeclIdent ds))
418− in foldMap (f'' s') ds
419− f' s (ValueDeclaration name _ bs (Right val)) =
420− let s' = S.insert name s
421− in foldMap (h'' s') bs <> g'' s' val
422− f' s (ValueDeclaration name _ bs (Left gs)) =
423− let s' = S.insert name s
424− s'' = S.union s' (S.fromList (concatMap binderNames bs))
425− in foldMap (h'' s') bs <> foldMap (\(grd, val) -> g'' s'' grd <> g'' s'' val) gs
426− f' s (BindingGroupDeclaration ds) =
427− let s' = S.union s (S.fromList (map (\(name, _, _) -> name) ds))
428− in foldMap (\(_, _, val) -> g'' s' val) ds
429− f' s (TypeClassDeclaration _ _ _ ds) = foldMap (f'' s) ds
430− f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds
431− f' s (PositionedDeclaration _ _ d) = f'' s d
432− f' _ _ = mempty
433−
434− g'' s a = g s a <> g' s a
435−
436− g' s (UnaryMinus v1) = g'' s v1
437− g' s (BinaryNoParens op v1 v2) = g' s op <> g' s v1 <> g' s v2
438− g' s (Parens v1) = g'' s v1
439− g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v
440− g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v
441− g' s (ArrayLiteral vs) = foldMap (g'' s) vs
442− g' s (ObjectLiteral vs) = foldMap (g'' s . snd) vs
443− g' s (ObjectConstructor vs) = foldMap (g'' s) (mapMaybe snd vs)
444− g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
445− g' s (Accessor _ v1) = g'' s v1
446− g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs
447− g' s (ObjectUpdater obj vs) = foldMap (g'' s) obj <> foldMap (g'' s) (mapMaybe snd vs)
448− g' s (Abs (Left name) v1) =
449− let s' = S.insert name s
450− in g'' s' v1
451− g' s (Abs (Right b) v1) =
452− let s' = S.union (S.fromList (binderNames b)) s
453− in g'' s' v1
454− g' s (App v1 v2) = g'' s v1 <> g'' s v2
455− g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
456− g' s (Case vs alts) = foldMap (g'' s) vs <> foldMap (i'' s) alts
457− g' s (TypedValue _ v1 _) = g'' s v1
458− g' s (Let ds v1) =
459− let s' = S.union s (S.fromList (mapMaybe getDeclIdent ds))
460− in foldMap (f'' s') ds <> g'' s' v1
461− g' s (Do es) = fold . snd . mapAccumL j'' s $ es
462− g' s (PositionedValue _ _ v1) = g'' s v1
463− g' _ _ = mempty
464−
465− h'' s a = h s a <> h' s a
466−
467− h' s (ConstructorBinder _ bs) = foldMap (h'' s) bs
468− h' s (ObjectBinder bs) = foldMap (h'' s . snd) bs
469− h' s (ArrayBinder bs) = foldMap (h'' s) bs
470− h' s (NamedBinder name b1) =
471− let s' = S.insert name s
472− in h'' s' b1
473− h' s (PositionedBinder _ _ b1) = h'' s b1
474− h' s (TypedBinder _ b1) = h'' s b1
475− h' _ _ = mempty
476−
477− i'' s a = i s a <> i' s a
478−
479− i' s (CaseAlternative bs (Right val)) =
480− let s' = S.union s (S.fromList (concatMap binderNames bs))
481− in foldMap (h'' s) bs <> g'' s' val
482− i' s (CaseAlternative bs (Left gs)) =
483− let s' = S.union s (S.fromList (concatMap binderNames bs))
484− in foldMap (h'' s) bs <> foldMap (\(grd, val) -> g'' s' grd <> g'' s' val) gs
485−
486− j'' s a = let (s', r) = j' s a in (s', j s a <> r)
487−
488− j' s (DoNotationValue v) = (s, g'' s v)
489− j' s (DoNotationBind b v) =
490− let s' = S.union (S.fromList (binderNames b)) s
491− in (s', h'' s b <> g'' s' v)
492− j' s (DoNotationLet ds) =
493− let s' = S.union s (S.fromList (mapMaybe getDeclIdent ds))
494− in (s', foldMap (f'' s') ds)
495− j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
496−
497− getDeclIdent :: Declaration -> Maybe Ident
498− getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d
499− getDeclIdent (ValueDeclaration ident _ _ _) = Just ident
500− getDeclIdent (TypeDeclaration ident _) = Just ident
501− getDeclIdent _ = Nothing
502−
503−accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
504−accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
505− where
506− forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
507− forDecls (ExternDeclaration _ ty) = f ty
508− forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
509− forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
510− forDecls (TypeSynonymDeclaration _ _ ty) = f ty
511− forDecls (TypeDeclaration _ ty) = f ty
512− forDecls _ = mempty
513−
514− forValues (TypeClassDictionary (_, cs) _) = mconcat (map f cs)
515− forValues (SuperClassDictionary _ tys) = mconcat (map f tys)
516− forValues (TypedValue _ _ ty) = f ty
517− forValues _ = mempty
src/Language/PureScript/Bundle.hsdeleted−552
@@ -1,552 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : psc-bundle
4−-- Copyright : (c) Phil Freeman 2015
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Bundles compiled PureScript modules for the browser.
12−--
13−-- This module takes as input the individual generated modules from 'Language.PureScript.Make' and
14−-- performs dead code elimination, filters empty modules,
15−-- and generates the final Javascript bundle.
16−-----------------------------------------------------------------------------
17−
18−{-# LANGUAGE PatternGuards #-}
19−{-# LANGUAGE FlexibleContexts #-}
20−{-# LANGUAGE ScopedTypeVariables #-}
21−{-# LANGUAGE TupleSections #-}
22−
23−module Language.PureScript.Bundle (
24− bundle
25− , ModuleIdentifier(..)
26− , moduleName
27− , ModuleType(..)
28− , ErrorMessage(..)
29− , printErrorMessage
30−) where
31−
32−import Prelude ()
33−import Prelude.Compat
34−
35−import Data.List (nub, stripPrefix)
36−import Data.Maybe (mapMaybe, catMaybes, fromMaybe)
37−import Data.Generics (everything, everywhere, mkQ, mkT)
38−import Data.Graph
39−import Data.Version (showVersion)
40−
41−import qualified Data.Set as S
42−
43−import Control.Monad
44−import Control.Monad.Error.Class
45−import Language.JavaScript.Parser
46−
47−import qualified Paths_purescript as Paths
48−
49−-- | The type of error messages. We separate generation and rendering of errors using a data
50−-- type, in case we need to match on error types later.
51−data ErrorMessage
52− = UnsupportedModulePath String
53− | InvalidTopLevel
54− | UnableToParseModule String
55− | UnsupportedExport
56− | ErrorInModule ModuleIdentifier ErrorMessage
57− deriving (Show, Read)
58−
59−-- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.
60−data ModuleType
61− = Regular
62− | Foreign
63− deriving (Show, Read, Eq, Ord)
64−
65−showModuleType :: ModuleType -> String
66−showModuleType Regular = "Regular"
67−showModuleType Foreign = "Foreign"
68−
69−-- | A module is identified by its module name and its type.
70−data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Read, Eq, Ord)
71−
72−moduleName :: ModuleIdentifier -> String
73−moduleName (ModuleIdentifier name _) = name
74−
75−-- | A piece of code is identified by its module and its name. These keys are used to label vertices
76−-- in the dependency graph.
77−type Key = (ModuleIdentifier, String)
78−
79−-- | An export is either a "regular export", which exports a name from the regular module we are in,
80−-- or a reexport of a declaration in the corresponding foreign module.
81−--
82−-- Regular exports are labelled, since they might re-export an operator with another name.
83−data ExportType
84− = RegularExport String
85− | ForeignReexport
86− deriving (Show, Read, Eq, Ord)
87−
88−-- | There are four types of module element we are interested in:
89−--
90−-- 1) Require statements
91−-- 2) Member declarations
92−-- 3) Export lists
93−-- 4) Everything else
94−--
95−-- Each is labelled with the original AST node which generated it, so that we can dump it back
96−-- into the output during codegen.
97−data ModuleElement
98− = Require JSNode String ModuleIdentifier
99− | Member JSNode Bool String [JSNode] [Key]
100− | ExportsList [(ExportType, String, JSNode, [Key])]
101− | Other JSNode
102− deriving (Show, Read)
103−
104−-- | A module is just a list of elements of the types listed above.
105−data Module = Module ModuleIdentifier [ModuleElement] deriving (Show, Read)
106−
107−-- | Prepare an error message for consumption by humans.
108−printErrorMessage :: ErrorMessage -> [String]
109−printErrorMessage (UnsupportedModulePath s) =
110− [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
111− , "The following file names are supported:"
112− , " 1) index.js (psc native modules)"
113− , " 2) foreign.js (psc foreign modules)"
114− ]
115−printErrorMessage InvalidTopLevel =
116− [ "Expected a list of source elements at the top level." ]
117−printErrorMessage (UnableToParseModule err) =
118− [ "The module could not be parsed:"
119− , err
120− ]
121−printErrorMessage UnsupportedExport =
122− [ "An export was unsupported. Exports can be defined in one of two ways: "
123− , " 1) exports.name = ..."
124− , " 2) exports = { ... }"
125− ]
126−printErrorMessage (ErrorInModule mid e) =
127− ("Error in module " ++ displayIdentifier mid ++ ":")
128− : ""
129− : map (" " ++) (printErrorMessage e)
130− where
131− displayIdentifier (ModuleIdentifier name ty) =
132− name ++ " (" ++ showModuleType ty ++ ")"
133−
134−-- | Unpack the node inside a JSNode. This is useful when pattern matching.
135−node :: JSNode -> Node
136−node (NN n) = n
137−node (NT n _ _) = n
138−
139−-- | Calculate the ModuleIdentifier which a require(...) statement imports.
140−checkImportPath :: Maybe FilePath -> String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier
141−checkImportPath _ "./foreign" m _ =
142− Just (ModuleIdentifier (moduleName m) Foreign)
143−checkImportPath requirePath name _ names
144− | Just name' <- stripPrefix (fromMaybe "" requirePath) name
145− , name' `S.member` names = Just (ModuleIdentifier name' Regular)
146−checkImportPath _ _ _ _ = Nothing
147−
148−-- | Compute the dependencies of all elements in a module, and add them to the tree.
149−--
150−-- Members and exports can have dependencies. A dependency is of one of the following forms:
151−--
152−-- 1) module.name or member["name"]
153−--
154−-- where module was imported using
155−--
156−-- var module = require("Module.Name");
157−--
158−-- 2) name
159−--
160−-- where name is the name of a member defined in the current module.
161−withDeps :: Module -> Module
162−withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
163− where
164− -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
165− imports :: [(String, ModuleIdentifier)]
166− imports = mapMaybe toImport es
167− where
168− toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
169− toImport (Require _ nm mid) = Just (nm, mid)
170− toImport _ = Nothing
171−
172− -- | Collects all member names in scope, so that we can identify dependencies of the second type.
173− boundNames :: [String]
174− boundNames = mapMaybe toBoundName es
175− where
176− toBoundName :: ModuleElement -> Maybe String
177− toBoundName (Member _ _ nm _ _) = Just nm
178− toBoundName _ = Nothing
179−
180− -- | Calculate dependencies and add them to the current element.
181− expandDeps :: ModuleElement -> ModuleElement
182− expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))
183− expandDeps (ExportsList exps) = ExportsList (map expand exps)
184− where
185− expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
186− expandDeps other = other
187−
188− dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]
189− dependencies m = everything (++) (mkQ [] toReference)
190− where
191− toReference :: Node -> [(ModuleIdentifier, String)]
192− toReference (JSMemberDot [ mn ] _ nm)
193− | JSIdentifier mn' <- node mn
194− , JSIdentifier nm' <- node nm
195− , Just mid <- lookup mn' imports
196− = [(mid, nm')]
197− toReference (JSMemberSquare [ mn ] _ nm _)
198− | JSIdentifier mn' <- node mn
199− , JSExpression [ s ] <- node nm
200− , JSStringLiteral _ nm' <- node s
201− , Just mid <- lookup mn' imports
202− = [(mid, nm')]
203− toReference (JSIdentifier nm)
204− | nm `elem` boundNames
205− = [(m, nm)]
206− toReference _ = []
207−
208−-- | Attempt to create a Module from a Javascript AST.
209−--
210−-- Each type of module element is matched using pattern guards, and everything else is bundled into the
211−-- Other constructor.
212−toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => Maybe FilePath -> S.Set String -> ModuleIdentifier -> JSNode -> m Module
213−toModule requirePath mids mid top
214− | JSSourceElementsTop ns <- node top = Module mid <$> traverse toModuleElement ns
215− | otherwise = err InvalidTopLevel
216− where
217− err = throwError . ErrorInModule mid
218−
219− toModuleElement :: JSNode -> m ModuleElement
220− toModuleElement n
221− | JSVariables var [ varIntro ] _ <- node n
222− , JSLiteral "var" <- node var
223− , JSVarDecl impN [ eq, req, impP ] <- node varIntro
224− , JSIdentifier importName <- node impN
225− , JSLiteral "=" <- node eq
226− , JSIdentifier "require" <- node req
227− , JSArguments _ [ impS ] _ <- node impP
228− , JSStringLiteral _ importPath <- node impS
229− , Just importPath' <- checkImportPath requirePath importPath mid mids
230− = pure (Require n importName importPath')
231− toModuleElement n
232− | JSVariables var [ varIntro ] _ <- node n
233− , JSLiteral "var" <- node var
234− , JSVarDecl declN (eq : decl) <- node varIntro
235− , JSIdentifier name <- node declN
236− , JSLiteral "=" <- node eq
237− = pure (Member n False name decl [])
238− toModuleElement n
239− | JSExpression (e : op : decl) <- node n
240− , Just name <- accessor (node e)
241− , JSOperator eq <- node op
242− , JSLiteral "=" <- node eq
243− = pure (Member n True name decl [])
244− where
245− accessor :: Node -> Maybe String
246− accessor (JSMemberDot [ exports ] _ nm)
247− | JSIdentifier "exports" <- node exports
248− , JSIdentifier name <- node nm
249− = Just name
250− accessor (JSMemberSquare [ exports ] _ nm _)
251− | JSIdentifier "exports" <- node exports
252− , JSExpression [e] <- node nm
253− , JSStringLiteral _ name <- node e
254− = Just name
255− accessor _ = Nothing
256− toModuleElement n
257− | JSExpression (mnExp : op : obj: _) <- node n
258− , JSMemberDot [ mn ] _ e <- node mnExp
259− , JSIdentifier "module" <- node mn
260− , JSIdentifier "exports" <- node e
261− , JSOperator eq <- node op
262− , JSLiteral "=" <- node eq
263− , JSObjectLiteral _ props _ <- node obj
264− = ExportsList <$> traverse toExport (filter (not . isSeparator) (map node props))
265− where
266− toExport :: Node -> m (ExportType, String, JSNode, [Key])
267− toExport (JSPropertyNameandValue name _ [val] ) =
268− (,,val,[]) <$> exportType (node val)
269− <*> extractLabel (node name)
270− toExport _ = err UnsupportedExport
271−
272− exportType :: Node -> m ExportType
273− exportType (JSMemberDot [f] _ _)
274− | JSIdentifier "$foreign" <- node f
275− = pure ForeignReexport
276− exportType (JSMemberSquare [f] _ _ _)
277− | JSIdentifier "$foreign" <- node f
278− = pure ForeignReexport
279− exportType (JSIdentifier s) = pure (RegularExport s)
280− exportType _ = err UnsupportedExport
281−
282− extractLabel :: Node -> m String
283− extractLabel (JSStringLiteral _ nm) = pure nm
284− extractLabel (JSIdentifier nm) = pure nm
285− extractLabel _ = err UnsupportedExport
286−
287− isSeparator :: Node -> Bool
288− isSeparator (JSLiteral ",") = True
289− isSeparator _ = False
290− toModuleElement other = pure (Other other)
291−
292−-- | Eliminate unused code based on the specified entry point set.
293−compile :: [Module] -> [ModuleIdentifier] -> [Module]
294−compile modules [] = modules
295−compile modules entryPoints = filteredModules
296− where
297− (graph, _, vertexFor) = graphFromEdges verts
298−
299− -- | The vertex set
300− verts :: [(ModuleElement, Key, [Key])]
301− verts = do
302− Module mid els <- modules
303− concatMap (toVertices mid) els
304− where
305− -- | Create a set of vertices for a module element.
306− --
307− -- Some special cases worth commenting on:
308− --
309− -- 1) Regular exports which simply export their own name do not count as dependencies.
310− -- Regular exports which rename and reexport an operator do count, however.
311− --
312− -- 2) Require statements don't contribute towards dependencies, since they effectively get
313− -- inlined wherever they are used inside other module elements.
314− toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
315− toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
316− toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
317− where
318− toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
319− toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
320− toVertex _ = Nothing
321− toVertices _ _ = []
322−
323− -- | The set of vertices whose connected components we are interested in keeping.
324− entryPointVertices :: [Vertex]
325− entryPointVertices = catMaybes $ do
326− (_, k@(mid, _), _) <- verts
327− guard $ mid `elem` entryPoints
328− return (vertexFor k)
329−
330− -- | The set of vertices reachable from an entry point
331− reachableSet :: S.Set Vertex
332− reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
333−
334− filteredModules :: [Module]
335− filteredModules = map filterUsed modules
336− where
337− filterUsed :: Module -> Module
338− filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
339− where
340− go :: [ModuleElement] -> [ModuleElement]
341− go [] = []
342− go (d : Other semi : rest)
343− | JSLiteral ";" <- node semi
344− , not (isDeclUsed d)
345− = go rest
346− go (d : rest)
347− | not (isDeclUsed d) = go rest
348− | otherwise = d : go rest
349−
350− -- | Filter out the exports for members which aren't used.
351− filterExports :: ModuleElement -> ModuleElement
352− filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
353− filterExports me = me
354−
355− isDeclUsed :: ModuleElement -> Bool
356− isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
357− isDeclUsed _ = True
358−
359− isKeyUsed :: Key -> Bool
360− isKeyUsed k
361− | Just me <- vertexFor k = me `S.member` reachableSet
362− | otherwise = False
363−
364−-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
365−-- defined in the right order.
366−sortModules :: [Module] -> [Module]
367−sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
368− where
369− (graph, nodeFor, _) = graphFromEdges $ do
370− m@(Module mid els) <- modules
371− return (m, mid, mapMaybe getKey els)
372−
373− getKey :: ModuleElement -> Maybe ModuleIdentifier
374− getKey (Require _ _ mi) = Just mi
375− getKey _ = Nothing
376−
377−-- | A module is empty if it contains no exported members (in other words,
378−-- if the only things left after dead code elimination are module imports and
379−-- "other" foreign code).
380−--
381−-- If a module is empty, we don't want to generate code for it.
382−isModuleEmpty :: Module -> Bool
383−isModuleEmpty (Module _ els) = all isElementEmpty els
384− where
385− isElementEmpty :: ModuleElement -> Bool
386− isElementEmpty (ExportsList exps) = null exps
387− isElementEmpty Require{} = True
388− isElementEmpty (Other _) = True
389− isElementEmpty _ = False
390−
391−-- | Generate code for a set of modules, including a call to main().
392−--
393−-- Modules get defined on the global PS object, as follows:
394−--
395−-- var PS = { };
396−-- (function(exports) {
397−-- ...
398−-- })(PS["Module.Name"] = PS["Module.Name"] || {});
399−--
400−-- In particular, a module and its foreign imports share the same namespace inside PS.
401−-- This saves us from having to generate unique names for a module and its foreign imports,
402−-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
403−-- (so there is no way to have overlaps in code generated by psc).
404−codeGen :: Maybe String -- ^ main module
405− -> String -- ^ namespace
406− -> [Module] -- ^ input modules
407− -> String
408−codeGen optionsMainModule optionsNamespace ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))
409− where
410− moduleToJS :: Module -> [JSNode]
411− moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
412− where
413− declToJS :: ModuleElement -> [JSNode]
414− declToJS (Member n _ _ _ _) = [n]
415− declToJS (Other n) = [n]
416− declToJS (Require _ nm req) =
417− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])
418− [ NN (JSVarDecl (sp (JSIdentifier nm))
419− [ sp (JSLiteral "=")
420− , moduleReference sp (moduleName req)
421− ])
422− ]
423− (nt (JSLiteral ";"))) ]
424− declToJS (ExportsList exps) = map toExport exps
425−
426− where
427− toExport :: (ExportType, String, JSNode, [Key]) -> JSNode
428− toExport (_, nm, val, _) =
429− NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]
430− (nt (JSLiteral "["))
431− (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))
432− (nt (JSLiteral "]")))
433− , NN (JSOperator (sp (JSLiteral "=")))
434− , reindent val
435− , nt (JSLiteral ";")
436− ])
437−
438− reindent :: JSNode -> JSNode
439− reindent (NT n _ _) = sp n
440− reindent nn = nn
441−
442− indent :: [JSNode] -> [JSNode]
443− indent = everywhere (mkT squash)
444− where
445− squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)
446− squash nn = nn
447−
448− splat (CommentA pos s) = CommentA (keepCol pos) s
449− splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
450− splat ann = ann
451−
452− keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)
453−
454− prelude :: [JSNode]
455− prelude =
456− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)
457− , WhiteSpace tokenPosnEmpty "\n"
458− ])
459− [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))
460− [ sp (JSLiteral "=")
461− , NN (JSObjectLiteral (sp (JSLiteral "{"))
462− []
463− (sp (JSLiteral "}")))
464− ])
465− ]
466− (nt (JSLiteral ";")))
467− , lf
468− ]
469−
470− moduleReference :: (Node -> JSNode) -> String -> JSNode
471− moduleReference f mn =
472− NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]
473− (nt (JSLiteral "["))
474− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
475− (nt (JSLiteral "]")))
476−
477− wrap :: String -> [JSNode] -> [JSNode]
478− wrap mn ds =
479− [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))
480− (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))
481− []
482− (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))
483− (NN (JSBlock [sp (JSLiteral "{")]
484− (lf : ds)
485− [nl (JSLiteral "}")])))]))
486− (nt (JSLiteral ")")))
487− , NN (JSArguments (nt (JSLiteral "("))
488− [ NN (JSExpression [ moduleReference nt mn
489− , NN (JSOperator (sp (JSLiteral "=")))
490− , NN (JSExpressionBinary "||"
491− [ moduleReference sp mn ]
492− (sp (JSLiteral "||"))
493− [ emptyObj ])
494− ])
495− ]
496− (nt (JSLiteral ")")))
497− ])
498− , nt (JSLiteral ";")
499− , lf
500− ]
501− where
502− emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))
503−
504− runMain :: String -> [JSNode]
505− runMain mn =
506− [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]
507− (nt (JSLiteral "["))
508− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
509− (nt (JSLiteral "]")))
510− ]
511− (nt (JSLiteral "."))
512− (nt (JSIdentifier "main")))
513− , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))
514− ])
515− , nt (JSLiteral ";")
516− ]
517−
518− nt :: Node -> JSNode
519− nt n = NT n tokenPosnEmpty []
520−
521− lf :: JSNode
522− lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
523−
524− sp :: Node -> JSNode
525− sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
526−
527− nl :: Node -> JSNode
528− nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
529−
530−-- | The bundling function.
531−-- This function performs dead code elimination, filters empty modules
532−-- and generates and prints the final Javascript bundle.
533−bundle :: (Applicative m, MonadError ErrorMessage m)
534− => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
535− -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
536− -> Maybe String -- ^ An optional main module.
537− -> String -- ^ The namespace (e.g. PS).
538− -> Maybe FilePath -- ^ The require path prefix
539− -> m String
540−bundle inputStrs entryPoints mainModule namespace requirePath = do
541− input <- forM inputStrs $ \(ident, js) -> do
542− ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
543− return (ident, ast)
544−
545− let mids = S.fromList (map (moduleName . fst) input)
546−
547− modules <- traverse (fmap withDeps . uncurry (toModule requirePath mids)) input
548−
549− let compiled = compile modules entryPoints
550− sorted = sortModules (filter (not . isModuleEmpty) compiled)
551−
552− return (codeGen mainModule namespace sorted)
src/Language/PureScript/CodeGen.hsdeleted−20
@@ -1,20 +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−-----------------------------------------------------------------------------
17−
18−module Language.PureScript.CodeGen (module C) where
19−
20−import Language.PureScript.CodeGen.JS as C
src/Language/PureScript/CodeGen/JS.hsdeleted−435
@@ -1,435 +0,0 @@
1−{-# LANGUAGE GADTs #-}
2−{-# LANGUAGE ViewPatterns #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−
6−-- |
7−-- This module generates code in the simplified Javascript intermediate representation from Purescript code
8−--
9−module Language.PureScript.CodeGen.JS
10− ( module AST
11− , module Common
12− , moduleToJs
13− ) where
14−
15−import Prelude ()
16−import Prelude.Compat
17−
18−import Data.List ((\\), delete, intersect)
19−import Data.Maybe (isNothing, fromMaybe)
20−import qualified Data.Map as M
21−import qualified Data.Foldable as F
22−import qualified Data.Traversable as T
23−
24−import Control.Arrow ((&&&))
25−import Control.Monad (replicateM, forM, void)
26−import Control.Monad.Error.Class (MonadError(..))
27−import Control.Monad.Reader (MonadReader, asks)
28−import Control.Monad.Supply.Class
29−
30−import Language.PureScript.Crash
31−import Language.PureScript.AST.SourcePos
32−import Language.PureScript.CodeGen.JS.AST as AST
33−import Language.PureScript.CodeGen.JS.Common as Common
34−import Language.PureScript.CoreFn
35−import Language.PureScript.Names
36−import Language.PureScript.Errors
37−import Language.PureScript.CodeGen.JS.Optimizer
38−import Language.PureScript.Options
39−import Language.PureScript.Traversals (sndM)
40−import qualified Language.PureScript.Constants as C
41−
42−import System.FilePath.Posix ((</>))
43−
44−-- |
45−-- Generate code in the simplified Javascript intermediate representation for all declarations in a
46−-- module.
47−--
48−moduleToJs
49− :: forall m
50− . (Applicative m, Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
51− => Module Ann
52− -> Maybe JS
53− -> m [JS]
54−moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
55− rethrow (addHint (ErrorInModule mn)) $ do
56− let usedNames = concatMap getNames decls
57− let mnLookup = renameImports usedNames imps
58− jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
59− let decls' = renameModules mnLookup decls
60− jsDecls <- mapM bindToJs decls'
61− optimized <- T.traverse (T.traverse optimize) jsDecls
62− F.traverse_ (F.traverse_ checkIntegers) optimized
63− comments <- not <$> asks optionsNoComments
64− let strict = JSStringLiteral "use strict"
65− let header = if comments && not (null coms) then JSComment coms strict else strict
66− let foreign' = [JSVariableIntroduction "$foreign" foreign_ | not $ null foreigns || isNothing foreign_]
67− let moduleBody = header : foreign' ++ jsImports ++ concat optimized
68− let foreignExps = exps `intersect` (fst `map` foreigns)
69− let standardExps = exps \\ foreignExps
70− let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
71− ++ map (runIdent &&& foreignIdent) foreignExps
72− return $ moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
73−
74− where
75−
76− -- |
77− -- Extracts all declaration names from a binding group.
78− --
79− getNames :: Bind Ann -> [Ident]
80− getNames (NonRec ident _) = [ident]
81− getNames (Rec vals) = map fst vals
82−
83− -- |
84− -- Creates alternative names for each module to ensure they don't collide
85− -- with declaration names.
86− --
87− renameImports :: [Ident] -> [ModuleName] -> M.Map ModuleName ModuleName
88− renameImports ids mns = go M.empty ids mns
89− where
90− go :: M.Map ModuleName ModuleName -> [Ident] -> [ModuleName] -> M.Map ModuleName ModuleName
91− go acc used (mn' : mns') =
92− let mni = Ident $ runModuleName mn'
93− in if mni `elem` used
94− then let newName = freshModuleName 1 mn' used
95− in go (M.insert mn' newName acc) (Ident (runModuleName newName) : used) mns'
96− else go (M.insert mn' mn' acc) (mni : used) mns'
97− go acc _ [] = acc
98−
99− freshModuleName :: Integer -> ModuleName -> [Ident] -> ModuleName
100− freshModuleName i mn'@(ModuleName pns) used =
101− let newName = ModuleName $ init pns ++ [ProperName $ runProperName (last pns) ++ "_" ++ show i]
102− in if Ident (runModuleName newName) `elem` used
103− then freshModuleName (i + 1) mn' used
104− else newName
105−
106− -- |
107− -- Generates Javascript code for a module import, binding the required module
108− -- to the alternative
109− --
110− importToJs :: M.Map ModuleName ModuleName -> ModuleName -> m JS
111− importToJs mnLookup mn' = do
112− path <- asks optionsRequirePath
113− let mnSafe = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
114− let moduleBody = JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
115− return $ JSVariableIntroduction (moduleNameToJs mnSafe) (Just moduleBody)
116−
117− -- |
118− -- Replaces the `ModuleName`s in the AST so that the generated code refers to
119− -- the collision-avoiding renamed module imports.
120− --
121− renameModules :: M.Map ModuleName ModuleName -> [Bind Ann] -> [Bind Ann]
122− renameModules mnLookup binds =
123− let (f, _, _) = everywhereOnValues id goExpr goBinder
124− in map f binds
125− where
126− goExpr :: Expr a -> Expr a
127− goExpr (Var ann q) = Var ann (renameQual q)
128− goExpr e = e
129− goBinder :: Binder a -> Binder a
130− goBinder (ConstructorBinder ann q1 q2 bs) = ConstructorBinder ann (renameQual q1) (renameQual q2) bs
131− goBinder b = b
132− renameQual :: Qualified a -> Qualified a
133− renameQual (Qualified (Just mn') a) =
134− let mnSafe = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
135− in Qualified (Just mnSafe) a
136− renameQual q = q
137−
138− -- |
139− -- Generate code in the simplified Javascript intermediate representation for a declaration
140− --
141− bindToJs :: Bind Ann -> m [JS]
142− bindToJs (NonRec ident val) = return <$> nonRecToJS ident val
143− bindToJs (Rec vals) = forM vals (uncurry nonRecToJS)
144−
145− -- |
146− -- Generate code in the simplified Javascript intermediate representation for a single non-recursive
147− -- declaration.
148− --
149− -- The main purpose of this function is to handle code generation for comments.
150− --
151− nonRecToJS :: Ident -> Expr Ann -> m JS
152− nonRecToJS i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
153− withoutComment <- asks optionsNoComments
154− if withoutComment
155− then nonRecToJS i (modifyAnn removeComments e)
156− else JSComment com <$> nonRecToJS i (modifyAnn removeComments e)
157− nonRecToJS ident val = do
158− js <- valueToJs val
159− return $ JSVariableIntroduction (identToJs ident) (Just js)
160−
161− -- |
162− -- Generate code in the simplified Javascript intermediate representation for a variable based on a
163− -- PureScript identifier.
164− --
165− var :: Ident -> JS
166− var = JSVar . identToJs
167−
168− -- |
169− -- Generate code in the simplified Javascript intermediate representation for an accessor based on
170− -- a PureScript identifier. If the name is not valid in Javascript (symbol based, reserved name) an
171− -- indexer is returned.
172− --
173− accessor :: Ident -> JS -> JS
174− accessor (Ident prop) = accessorString prop
175− accessor (Op op) = JSIndexer (JSStringLiteral op)
176− accessor (GenIdent _ _) = internalError "GenIdent in accessor"
177−
178− accessorString :: String -> JS -> JS
179− accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)
180− | otherwise = JSAccessor prop
181−
182− -- |
183− -- Generate code in the simplified Javascript intermediate representation for a value or expression.
184− --
185− valueToJs :: Expr Ann -> m JS
186− valueToJs (Literal (pos, _, _, _) l) =
187− maybe id rethrowWithPosition pos $ literalToValueJS l
188− valueToJs (Var (_, _, _, Just (IsConstructor _ [])) name) =
189− return $ JSAccessor "value" $ qualifiedToJS id name
190− valueToJs (Var (_, _, _, Just (IsConstructor _ _)) name) =
191− return $ JSAccessor "create" $ qualifiedToJS id name
192− valueToJs (Accessor _ prop val) =
193− accessorString prop <$> valueToJs val
194− valueToJs (ObjectUpdate _ o ps) = do
195− obj <- valueToJs o
196− sts <- mapM (sndM valueToJs) ps
197− extendObj obj sts
198− valueToJs e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
199− let args = unAbs e
200− in return $ JSFunction Nothing (map identToJs args) (JSBlock $ map assign args)
201− where
202− unAbs :: Expr Ann -> [Ident]
203− unAbs (Abs _ arg val) = arg : unAbs val
204− unAbs _ = []
205− assign :: Ident -> JS
206− assign name = JSAssignment (accessorString (runIdent name) (JSVar "this"))
207− (var name)
208− valueToJs (Abs _ arg val) = do
209− ret <- valueToJs val
210− return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
211− valueToJs e@App{} = do
212− let (f, args) = unApp e []
213− args' <- mapM valueToJs args
214− case f of
215− Var (_, _, _, Just IsNewtype) _ -> return (head args')
216− Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields ->
217− return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
218− Var (_, _, _, Just IsTypeClassConstructor) name ->
219− return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
220− _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs f
221− where
222− unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
223− unApp (App _ val arg) args = unApp val (arg : args)
224− unApp other args = (other, args)
225− valueToJs (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =
226− return $ if mn' == mn
227− then foreignIdent ident
228− else varToJs qi
229− valueToJs (Var (_, _, _, Just IsForeign) ident) =
230− error $ "Encountered an unqualified reference to a foreign ident " ++ showQualified showIdent ident
231− valueToJs (Var _ ident) =
232− return $ varToJs ident
233− valueToJs (Case (maybeSpan, _, _, _) values binders) = do
234− vals <- mapM valueToJs values
235− bindersToJs maybeSpan binders vals
236− valueToJs (Let _ ds val) = do
237− ds' <- concat <$> mapM bindToJs ds
238− ret <- valueToJs val
239− return $ JSApp (JSFunction Nothing [] (JSBlock (ds' ++ [JSReturn ret]))) []
240− valueToJs (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =
241− return $ JSVariableIntroduction ctor (Just $
242− JSObjectLiteral [("create",
243− JSFunction Nothing ["value"]
244− (JSBlock [JSReturn $ JSVar "value"]))])
245− valueToJs (Constructor _ _ (ProperName ctor) []) =
246− return $ iife ctor [ JSFunction (Just ctor) [] (JSBlock [])
247− , JSAssignment (JSAccessor "value" (JSVar ctor))
248− (JSUnary JSNew $ JSApp (JSVar ctor) []) ]
249− valueToJs (Constructor _ _ (ProperName ctor) fields) =
250− let constructor =
251− let body = [ JSAssignment (JSAccessor (identToJs f) (JSVar "this")) (var f) | f <- fields ]
252− in JSFunction (Just ctor) (identToJs `map` fields) (JSBlock body)
253− createFn =
254− let body = JSUnary JSNew $ JSApp (JSVar ctor) (var `map` fields)
255− in foldr (\f inner -> JSFunction Nothing [identToJs f] (JSBlock [JSReturn inner])) body fields
256− in return $ iife ctor [ constructor
257− , JSAssignment (JSAccessor "create" (JSVar ctor)) createFn
258− ]
259−
260− iife :: String -> [JS] -> JS
261− iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
262−
263− literalToValueJS :: Literal (Expr Ann) -> m JS
264− literalToValueJS (NumericLiteral (Left i)) = return $ JSNumericLiteral (Left i)
265− literalToValueJS (NumericLiteral (Right n)) = return $ JSNumericLiteral (Right n)
266− literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
267− literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
268− literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral b
269− literalToValueJS (ArrayLiteral xs) = JSArrayLiteral <$> mapM valueToJs xs
270− literalToValueJS (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM valueToJs) ps
271−
272− -- |
273− -- Shallow copy an object.
274− --
275− extendObj :: JS -> [(String, JS)] -> m JS
276− extendObj obj sts = do
277− newObj <- freshName
278− key <- freshName
279− let
280− jsKey = JSVar key
281− jsNewObj = JSVar newObj
282− block = JSBlock (objAssign:copy:extend ++ [JSReturn jsNewObj])
283− objAssign = JSVariableIntroduction newObj (Just $ JSObjectLiteral [])
284− copy = JSForIn key obj $ JSBlock [JSIfElse cond assign Nothing]
285− cond = JSApp (JSAccessor "hasOwnProperty" obj) [jsKey]
286− assign = JSBlock [JSAssignment (JSIndexer jsKey jsNewObj) (JSIndexer jsKey obj)]
287− stToAssign (s, js) = JSAssignment (JSAccessor s jsNewObj) js
288− extend = map stToAssign sts
289− return $ JSApp (JSFunction Nothing [] block) []
290−
291− -- |
292− -- Generate code in the simplified Javascript intermediate representation for a reference to a
293− -- variable.
294− --
295− varToJs :: Qualified Ident -> JS
296− varToJs (Qualified Nothing ident) = var ident
297− varToJs qual = qualifiedToJS id qual
298−
299− -- |
300− -- Generate code in the simplified Javascript intermediate representation for a reference to a
301− -- variable that may have a qualified name.
302− --
303− qualifiedToJS :: (a -> Ident) -> Qualified a -> JS
304− qualifiedToJS f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = JSVar . runIdent $ f a
305− qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))
306− qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a)
307−
308− foreignIdent :: Ident -> JS
309− foreignIdent ident = accessorString (runIdent ident) (JSVar "$foreign")
310−
311− -- |
312− -- Generate code in the simplified Javascript intermediate representation for pattern match binders
313− -- and guards.
314− --
315− bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [JS] -> m JS
316− bindersToJs maybeSpan binders vals = do
317− valNames <- replicateM (length vals) freshName
318− let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
319− jss <- forM binders $ \(CaseAlternative bs result) -> do
320− ret <- guardsToJs result
321− go valNames ret bs
322− return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ failedPatternError valNames])))
323− []
324− where
325− go :: [String] -> [JS] -> [Binder Ann] -> m [JS]
326− go _ done [] = return done
327− go (v:vs) done' (b:bs) = do
328− done'' <- go vs done' bs
329− binderToJs v done'' b
330− go _ _ _ = internalError "Invalid arguments to bindersToJs"
331−
332− failedPatternError :: [String] -> JS
333− failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral failedPatternMessage) (JSArrayLiteral $ zipWith valueError names vals)]
334−
335− failedPatternMessage :: String
336− failedPatternMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "
337−
338− valueError :: String -> JS -> JS
339− valueError _ l@(JSNumericLiteral _) = l
340− valueError _ l@(JSStringLiteral _) = l
341− valueError _ l@(JSBooleanLiteral _) = l
342− valueError s _ = JSAccessor "name" . JSAccessor "constructor" $ JSVar s
343−
344− guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]
345− guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
346− cond' <- valueToJs cond
347− done <- valueToJs val
348− return $ JSIfElse cond' (JSBlock [JSReturn done]) Nothing
349− guardsToJs (Right v) = return . JSReturn <$> valueToJs v
350−
351− -- |
352− -- Generate code in the simplified Javascript intermediate representation for a pattern match
353− -- binder.
354− --
355− binderToJs :: String -> [JS] -> Binder Ann -> m [JS]
356− binderToJs _ done (NullBinder{}) = return done
357− binderToJs varName done (LiteralBinder _ l) =
358− literalToBinderJS varName done l
359− binderToJs varName done (VarBinder _ ident) =
360− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
361− binderToJs varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
362− binderToJs varName done b
363− binderToJs varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do
364− js <- go (zip fields bs) done
365− return $ case ctorType of
366− ProductType -> js
367− SumType ->
368− [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS (Ident . runProperName) ctor))
369− (JSBlock js)
370− Nothing]
371− where
372− go :: [(Ident, Binder Ann)] -> [JS] -> m [JS]
373− go [] done' = return done'
374− go ((field, binder) : remain) done' = do
375− argVar <- freshName
376− done'' <- go remain done'
377− js <- binderToJs argVar done'' binder
378− return (JSVariableIntroduction argVar (Just (JSAccessor (identToJs field) (JSVar varName))) : js)
379− binderToJs _ _ ConstructorBinder{} =
380− internalError "binderToJs: Invalid ConstructorBinder in binderToJs"
381− binderToJs varName done (NamedBinder _ ident binder) = do
382− js <- binderToJs varName done binder
383− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
384−
385− literalToBinderJS :: String -> [JS] -> Literal (Binder Ann) -> m [JS]
386− literalToBinderJS varName done (NumericLiteral num) =
387− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
388− literalToBinderJS varName done (CharLiteral c) =
389− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral [c])) (JSBlock done) Nothing]
390− literalToBinderJS varName done (StringLiteral str) =
391− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
392− literalToBinderJS varName done (BooleanLiteral True) =
393− return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
394− literalToBinderJS varName done (BooleanLiteral False) =
395− return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
396− literalToBinderJS varName done (ObjectLiteral bs) = go done bs
397− where
398− go :: [JS] -> [(String, Binder Ann)] -> m [JS]
399− go done' [] = return done'
400− go done' ((prop, binder):bs') = do
401− propVar <- freshName
402− done'' <- go done' bs'
403− js <- binderToJs propVar done'' binder
404− return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
405− literalToBinderJS varName done (ArrayLiteral bs) = do
406− js <- go done 0 bs
407− return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
408− where
409− go :: [JS] -> Integer -> [Binder Ann] -> m [JS]
410− go done' _ [] = return done'
411− go done' index (binder:bs') = do
412− elVar <- freshName
413− done'' <- go done' (index + 1) bs'
414− js <- binderToJs elVar done'' binder
415− return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
416−
417− -- Check that all integers fall within the valid int range for JavaScript.
418− checkIntegers :: JS -> m ()
419− checkIntegers = void . everywhereOnJSTopDownM go
420− where
421− go :: JS -> m JS
422− go (JSUnary Negate (JSNumericLiteral (Left i))) =
423− -- Move the negation inside the literal; since this is a top-down
424− -- traversal doing this replacement will stop the next case from raising
425− -- the error when attempting to use -2147483648, as if left unrewritten
426− -- the value is `JSUnary Negate (JSNumericLiteral (Left 2147483648))`, and
427− -- 2147483648 is larger than the maximum allowed int.
428− return $ JSNumericLiteral (Left (-i))
429− go js@(JSNumericLiteral (Left i)) =
430− let minInt = -2147483648
431− maxInt = 2147483647
432− in if i < minInt || i > maxInt
433− then throwError . errorMessage $ IntOutOfRange i "JavaScript" minInt maxInt
434− else return js
435− go other = return other
src/Language/PureScript/CodeGen/JS/AST.hsdeleted−345
@@ -1,345 +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 Prelude ()
21−import Prelude.Compat
22−
23−import Control.Monad.Identity
24−import Data.Data
25−
26−import Language.PureScript.Comments
27−import Language.PureScript.Traversals
28−
29−-- |
30−-- Built-in unary operators
31−--
32−data UnaryOperator
33− -- |
34− -- Numeric negation
35− --
36− = Negate
37− -- |
38− -- Boolean negation
39− --
40− | Not
41− -- |
42− -- Bitwise negation
43− --
44− | BitwiseNot
45− -- |
46− -- Numeric unary \'plus\'
47− --
48− | Positive
49− -- |
50− -- Constructor
51− --
52− | JSNew deriving (Show, Read, Eq, Data, Typeable)
53−
54−-- |
55−-- Built-in binary operators
56−--
57−data BinaryOperator
58− -- |
59− -- Numeric addition
60− --
61− = Add
62− -- |
63− -- Numeric subtraction
64− --
65− | Subtract
66− -- |
67− -- Numeric multiplication
68− --
69− | Multiply
70− -- |
71− -- Numeric division
72− --
73− | Divide
74− -- |
75− -- Remainder
76− --
77− | Modulus
78− -- |
79− -- Generic equality test
80− --
81− | EqualTo
82− -- |
83− -- Generic inequality test
84− --
85− | NotEqualTo
86− -- |
87− -- Numeric less-than
88− --
89− | LessThan
90− -- |
91− -- Numeric less-than-or-equal
92− --
93− | LessThanOrEqualTo
94− -- |
95− -- Numeric greater-than
96− --
97− | GreaterThan
98− -- |
99− -- Numeric greater-than-or-equal
100− --
101− | GreaterThanOrEqualTo
102− -- |
103− -- Boolean and
104− --
105− | And
106− -- |
107− -- Boolean or
108− --
109− | Or
110− -- |
111− -- Bitwise and
112− --
113− | BitwiseAnd
114− -- |
115− -- Bitwise or
116− --
117− | BitwiseOr
118− -- |
119− -- Bitwise xor
120− --
121− | BitwiseXor
122− -- |
123− -- Bitwise left shift
124− --
125− | ShiftLeft
126− -- |
127− -- Bitwise right shift
128− --
129− | ShiftRight
130− -- |
131− -- Bitwise right shift with zero-fill
132− --
133− | ZeroFillShiftRight deriving (Show, Read, Eq, Data, Typeable)
134−
135−-- |
136−-- Data type for simplified Javascript expressions
137−--
138−data JS
139− -- |
140− -- A numeric literal
141− --
142− = JSNumericLiteral (Either Integer Double)
143− -- |
144− -- A string literal
145− --
146− | JSStringLiteral String
147− -- |
148− -- A boolean literal
149− --
150− | JSBooleanLiteral Bool
151− -- |
152− -- A unary operator application
153− --
154− | JSUnary UnaryOperator JS
155− -- |
156− -- A binary operator application
157− --
158− | JSBinary BinaryOperator JS JS
159− -- |
160− -- An array literal
161− --
162− | JSArrayLiteral [JS]
163− -- |
164− -- An array indexer expression
165− --
166− | JSIndexer JS JS
167− -- |
168− -- An object literal
169− --
170− | JSObjectLiteral [(String, JS)]
171− -- |
172− -- An object property accessor expression
173− --
174− | JSAccessor String JS
175− -- |
176− -- A function introduction (optional name, arguments, body)
177− --
178− | JSFunction (Maybe String) [String] JS
179− -- |
180− -- Function application
181− --
182− | JSApp JS [JS]
183− -- |
184− -- Variable
185− --
186− | JSVar String
187− -- |
188− -- Conditional expression
189− --
190− | JSConditional JS JS JS
191− -- |
192− -- A block of expressions in braces
193− --
194− | JSBlock [JS]
195− -- |
196− -- A variable introduction and optional initialization
197− --
198− | JSVariableIntroduction String (Maybe JS)
199− -- |
200− -- A variable assignment
201− --
202− | JSAssignment JS JS
203− -- |
204− -- While loop
205− --
206− | JSWhile JS JS
207− -- |
208− -- For loop
209− --
210− | JSFor String JS JS JS
211− -- |
212− -- ForIn loop
213− --
214− | JSForIn String JS JS
215− -- |
216− -- If-then-else statement
217− --
218− | JSIfElse JS JS (Maybe JS)
219− -- |
220− -- Return statement
221− --
222− | JSReturn JS
223− -- |
224− -- Throw statement
225− --
226− | JSThrow JS
227− -- |
228− -- Type-Of operator
229− --
230− | JSTypeOf JS
231− -- |
232− -- InstanceOf test
233− --
234− | JSInstanceOf JS JS
235− -- |
236− -- Labelled statement
237− --
238− | JSLabel String JS
239− -- |
240− -- Break statement
241− --
242− | JSBreak String
243− -- |
244− -- Continue statement
245− --
246− | JSContinue String
247− -- |
248− -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)
249− --
250− | JSRaw String
251− -- |
252− -- Commented Javascript
253− --
254− | JSComment [Comment] JS deriving (Show, Read, Eq, Data, Typeable)
255−
256−--
257−-- Traversals
258−--
259−
260−everywhereOnJS :: (JS -> JS) -> JS -> JS
261−everywhereOnJS f = go
262− where
263− go :: JS -> JS
264− go (JSUnary op j) = f (JSUnary op (go j))
265− go (JSBinary op j1 j2) = f (JSBinary op (go j1) (go j2))
266− go (JSArrayLiteral js) = f (JSArrayLiteral (map go js))
267− go (JSIndexer j1 j2) = f (JSIndexer (go j1) (go j2))
268− go (JSObjectLiteral js) = f (JSObjectLiteral (map (fmap go) js))
269− go (JSAccessor prop j) = f (JSAccessor prop (go j))
270− go (JSFunction name args j) = f (JSFunction name args (go j))
271− go (JSApp j js) = f (JSApp (go j) (map go js))
272− go (JSConditional j1 j2 j3) = f (JSConditional (go j1) (go j2) (go j3))
273− go (JSBlock js) = f (JSBlock (map go js))
274− go (JSVariableIntroduction name j) = f (JSVariableIntroduction name (fmap go j))
275− go (JSAssignment j1 j2) = f (JSAssignment (go j1) (go j2))
276− go (JSWhile j1 j2) = f (JSWhile (go j1) (go j2))
277− go (JSFor name j1 j2 j3) = f (JSFor name (go j1) (go j2) (go j3))
278− go (JSForIn name j1 j2) = f (JSForIn name (go j1) (go j2))
279− go (JSIfElse j1 j2 j3) = f (JSIfElse (go j1) (go j2) (fmap go j3))
280− go (JSReturn js) = f (JSReturn (go js))
281− go (JSThrow js) = f (JSThrow (go js))
282− go (JSTypeOf js) = f (JSTypeOf (go js))
283− go (JSLabel name js) = f (JSLabel name (go js))
284− go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))
285− go (JSComment com j) = f (JSComment com (go j))
286− go other = f other
287−
288−everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
289−everywhereOnJSTopDown f = runIdentity . everywhereOnJSTopDownM (Identity . f)
290−
291−everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS
292−everywhereOnJSTopDownM f = f >=> go
293− where
294− f' = f >=> go
295− go (JSUnary op j) = JSUnary op <$> f' j
296− go (JSBinary op j1 j2) = JSBinary op <$> f' j1 <*> f' j2
297− go (JSArrayLiteral js) = JSArrayLiteral <$> traverse f' js
298− go (JSIndexer j1 j2) = JSIndexer <$> f' j1 <*> f' j2
299− go (JSObjectLiteral js) = JSObjectLiteral <$> traverse (sndM f') js
300− go (JSAccessor prop j) = JSAccessor prop <$> f' j
301− go (JSFunction name args j) = JSFunction name args <$> f' j
302− go (JSApp j js) = JSApp <$> f' j <*> traverse f' js
303− go (JSConditional j1 j2 j3) = JSConditional <$> f' j1 <*> f' j2 <*> f' j3
304− go (JSBlock js) = JSBlock <$> traverse f' js
305− go (JSVariableIntroduction name j) = JSVariableIntroduction name <$> traverse f' j
306− go (JSAssignment j1 j2) = JSAssignment <$> f' j1 <*> f' j2
307− go (JSWhile j1 j2) = JSWhile <$> f' j1 <*> f' j2
308− go (JSFor name j1 j2 j3) = JSFor name <$> f' j1 <*> f' j2 <*> f' j3
309− go (JSForIn name j1 j2) = JSForIn name <$> f' j1 <*> f' j2
310− go (JSIfElse j1 j2 j3) = JSIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
311− go (JSReturn j) = JSReturn <$> f' j
312− go (JSThrow j) = JSThrow <$> f' j
313− go (JSTypeOf j) = JSTypeOf <$> f' j
314− go (JSLabel name j) = JSLabel name <$> f' j
315− go (JSInstanceOf j1 j2) = JSInstanceOf <$> f' j1 <*> f' j2
316− go (JSComment com j) = JSComment com <$> f' j
317− go other = f other
318−
319−everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
320−everythingOnJS (<>) f = go
321− where
322− go j@(JSUnary _ j1) = f j <> go j1
323− go j@(JSBinary _ j1 j2) = f j <> go j1 <> go j2
324− go j@(JSArrayLiteral js) = foldl (<>) (f j) (map go js)
325− go j@(JSIndexer j1 j2) = f j <> go j1 <> go j2
326− go j@(JSObjectLiteral js) = foldl (<>) (f j) (map (go . snd) js)
327− go j@(JSAccessor _ j1) = f j <> go j1
328− go j@(JSFunction _ _ j1) = f j <> go j1
329− go j@(JSApp j1 js) = foldl (<>) (f j <> go j1) (map go js)
330− go j@(JSConditional j1 j2 j3) = f j <> go j1 <> go j2 <> go j3
331− go j@(JSBlock js) = foldl (<>) (f j) (map go js)
332− go j@(JSVariableIntroduction _ (Just j1)) = f j <> go j1
333− go j@(JSAssignment j1 j2) = f j <> go j1 <> go j2
334− go j@(JSWhile j1 j2) = f j <> go j1 <> go j2
335− go j@(JSFor _ j1 j2 j3) = f j <> go j1 <> go j2 <> go j3
336− go j@(JSForIn _ j1 j2) = f j <> go j1 <> go j2
337− go j@(JSIfElse j1 j2 Nothing) = f j <> go j1 <> go j2
338− go j@(JSIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3
339− go j@(JSReturn j1) = f j <> go j1
340− go j@(JSThrow j1) = f j <> go j1
341− go j@(JSTypeOf j1) = f j <> go j1
342− go j@(JSLabel _ j1) = f j <> go j1
343− go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2
344− go j@(JSComment _ j1) = f j <> go j1
345− go other = f other
src/Language/PureScript/CodeGen/JS/Common.hsdeleted−231
@@ -1,231 +0,0 @@
1−-- |
2−-- Common code generation utility functions
3−--
4−module Language.PureScript.CodeGen.JS.Common where
5−
6−import Data.Char
7−import Data.List (intercalate)
8−
9−import Language.PureScript.Crash
10−import Language.PureScript.Names
11−
12−moduleNameToJs :: ModuleName -> String
13−moduleNameToJs (ModuleName pns) =
14− let name = intercalate "_" (runProperName `map` pns)
15− in if nameIsJsBuiltIn name then "$$" ++ name else name
16−
17−-- |
18−-- Convert an Ident into a valid Javascript identifier:
19−--
20−-- * Alphanumeric characters are kept unmodified.
21−--
22−-- * Reserved javascript identifiers are prefixed with '$$'.
23−--
24−-- * Symbols are prefixed with '$' followed by a symbol name or their ordinal value.
25−--
26−identToJs :: Ident -> String
27−identToJs (Ident name)
28− | nameIsJsReserved name || nameIsJsBuiltIn name = "$$" ++ name
29− | otherwise = concatMap identCharToString name
30−identToJs (Op op) = concatMap identCharToString op
31−identToJs (GenIdent _ _) = internalError "GenIdent in identToJs"
32−
33−-- |
34−-- Test if a string is a valid JS identifier without escaping.
35−--
36−identNeedsEscaping :: String -> Bool
37−identNeedsEscaping s = s /= identToJs (Ident s)
38−
39−-- |
40−-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
41−-- ordinal value.
42−--
43−identCharToString :: Char -> String
44−identCharToString c | isAlphaNum c = [c]
45−identCharToString '_' = "_"
46−identCharToString '.' = "$dot"
47−identCharToString '$' = "$dollar"
48−identCharToString '~' = "$tilde"
49−identCharToString '=' = "$eq"
50−identCharToString '<' = "$less"
51−identCharToString '>' = "$greater"
52−identCharToString '!' = "$bang"
53−identCharToString '#' = "$hash"
54−identCharToString '%' = "$percent"
55−identCharToString '^' = "$up"
56−identCharToString '&' = "$amp"
57−identCharToString '|' = "$bar"
58−identCharToString '*' = "$times"
59−identCharToString '/' = "$div"
60−identCharToString '+' = "$plus"
61−identCharToString '-' = "$minus"
62−identCharToString ':' = "$colon"
63−identCharToString '\\' = "$bslash"
64−identCharToString '?' = "$qmark"
65−identCharToString '@' = "$at"
66−identCharToString '\'' = "$prime"
67−identCharToString c = '$' : show (ord c)
68−
69−-- |
70−-- Checks whether an identifier name is reserved in Javascript.
71−--
72−nameIsJsReserved :: String -> Bool
73−nameIsJsReserved name =
74− name `elem` jsAnyReserved
75−
76−-- |
77−-- Checks whether a name matches a built-in value in Javascript.
78−--
79−nameIsJsBuiltIn :: String -> Bool
80−nameIsJsBuiltIn name =
81− elem name
82− [ "arguments"
83− , "Array"
84− , "ArrayBuffer"
85− , "Boolean"
86− , "DataView"
87− , "Date"
88− , "decodeURI"
89− , "decodeURIComponent"
90− , "encodeURI"
91− , "encodeURIComponent"
92− , "Error"
93− , "escape"
94− , "eval"
95− , "EvalError"
96− , "Float32Array"
97− , "Float64Array"
98− , "Function"
99− , "Infinity"
100− , "Int16Array"
101− , "Int32Array"
102− , "Int8Array"
103− , "Intl"
104− , "isFinite"
105− , "isNaN"
106− , "JSON"
107− , "Map"
108− , "Math"
109− , "NaN"
110− , "Number"
111− , "Object"
112− , "parseFloat"
113− , "parseInt"
114− , "Promise"
115− , "Proxy"
116− , "RangeError"
117− , "ReferenceError"
118− , "Reflect"
119− , "RegExp"
120− , "Set"
121− , "SIMD"
122− , "String"
123− , "Symbol"
124− , "SyntaxError"
125− , "TypeError"
126− , "Uint16Array"
127− , "Uint32Array"
128− , "Uint8Array"
129− , "Uint8ClampedArray"
130− , "undefined"
131− , "unescape"
132− , "URIError"
133− , "WeakMap"
134− , "WeakSet"
135− ]
136−
137−jsAnyReserved :: [String]
138−jsAnyReserved =
139− concat
140− [ jsKeywords
141− , jsSometimesReserved
142− , jsFutureReserved
143− , jsFutureReservedStrict
144− , jsOldReserved
145− , jsLiterals
146− ]
147−
148−jsKeywords :: [String]
149−jsKeywords =
150− [ "break"
151− , "case"
152− , "catch"
153− , "class"
154− , "const"
155− , "continue"
156− , "debugger"
157− , "default"
158− , "delete"
159− , "do"
160− , "else"
161− , "export"
162− , "extends"
163− , "finally"
164− , "for"
165− , "function"
166− , "if"
167− , "import"
168− , "in"
169− , "instanceof"
170− , "new"
171− , "return"
172− , "super"
173− , "switch"
174− , "this"
175− , "throw"
176− , "try"
177− , "typeof"
178− , "var"
179− , "void"
180− , "while"
181− , "with"
182− ]
183−
184−jsSometimesReserved :: [String]
185−jsSometimesReserved =
186− [ "await"
187− , "let"
188− , "static"
189− , "yield"
190− ]
191−
192−jsFutureReserved :: [String]
193−jsFutureReserved =
194− [ "enum" ]
195−
196−jsFutureReservedStrict :: [String]
197−jsFutureReservedStrict =
198− [ "implements"
199− , "interface"
200− , "package"
201− , "private"
202− , "protected"
203− , "public"
204− ]
205−
206−jsOldReserved :: [String]
207−jsOldReserved =
208− [ "abstract"
209− , "boolean"
210− , "byte"
211− , "char"
212− , "double"
213− , "final"
214− , "float"
215− , "goto"
216− , "int"
217− , "long"
218− , "native"
219− , "short"
220− , "synchronized"
221− , "throws"
222− , "transient"
223− , "volatile"
224− ]
225−
226−jsLiterals :: [String]
227−jsLiterals =
228− [ "null"
229− , "true"
230− , "false"
231− ]
src/Language/PureScript/CodeGen/JS/Optimizer.hsdeleted−91
@@ -1,91 +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 Prelude ()
41−import Prelude.Compat
42−
43−import Control.Monad.Reader (MonadReader, ask, asks)
44−import Control.Monad.Supply.Class (MonadSupply)
45−
46−import Language.PureScript.CodeGen.JS.AST
47−import Language.PureScript.Options
48−import qualified Language.PureScript.Constants as C
49−
50−import Language.PureScript.CodeGen.JS.Optimizer.Common
51−import Language.PureScript.CodeGen.JS.Optimizer.TCO
52−import Language.PureScript.CodeGen.JS.Optimizer.MagicDo
53−import Language.PureScript.CodeGen.JS.Optimizer.Inliner
54−import Language.PureScript.CodeGen.JS.Optimizer.Unused
55−import Language.PureScript.CodeGen.JS.Optimizer.Blocks
56−
57−-- |
58−-- Apply a series of optimizer passes to simplified Javascript code
59−--
60−optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
61−optimize js = do
62− noOpt <- asks optionsNoOptimizations
63− if noOpt then return js else optimize' js
64−
65−optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
66−optimize' js = do
67− opts <- ask
68− untilFixedPoint (inlineFnComposition . applyAll
69− [ collapseNestedBlocks
70− , collapseNestedIfs
71− , tco opts
72− , magicDo opts
73− , removeCodeAfterReturnStatements
74− , removeUnusedArg
75− , removeUndefinedApp
76− , unThunk
77− , etaConvert
78− , evaluateIifes
79− , inlineVariables
80− , inlineValues
81− , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
82− , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
83− , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer
84− , inlineCommonOperators ]) js
85−
86−untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
87−untilFixedPoint f = go
88− where
89− go a = do
90− a' <- f a
91− 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−78
@@ -1,78 +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.Crash
21−import Language.PureScript.CodeGen.JS.AST
22−
23−applyAll :: [a -> a] -> a -> a
24−applyAll = foldl1 (.)
25−
26−replaceIdent :: String -> JS -> JS -> JS
27−replaceIdent var1 js = everywhereOnJS replace
28− where
29− replace (JSVar var2) | var1 == var2 = js
30− replace other = other
31−
32−replaceIdents :: [(String, JS)] -> JS -> JS
33−replaceIdents vars = everywhereOnJS replace
34− where
35− replace v@(JSVar var) = fromMaybe v $ lookup var vars
36− replace other = other
37−
38−isReassigned :: String -> JS -> Bool
39−isReassigned var1 = everythingOnJS (||) check
40− where
41− check :: JS -> Bool
42− check (JSFunction _ args _) | var1 `elem` args = True
43− check (JSVariableIntroduction arg _) | var1 == arg = True
44− check (JSAssignment (JSVar arg) _) | var1 == arg = True
45− check (JSFor arg _ _ _) | var1 == arg = True
46− check (JSForIn arg _ _) | var1 == arg = True
47− check _ = False
48−
49−isRebound :: JS -> JS -> Bool
50−isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnJS (++) variablesOf js)
51− where
52− variablesOf (JSVar var) = [var]
53− variablesOf _ = []
54−
55−isUsed :: String -> JS -> Bool
56−isUsed var1 = everythingOnJS (||) check
57− where
58− check :: JS -> Bool
59− check (JSVar var2) | var1 == var2 = True
60− check (JSAssignment target _) | var1 == targetVariable target = True
61− check _ = False
62−
63−targetVariable :: JS -> String
64−targetVariable (JSVar var) = var
65−targetVariable (JSAccessor _ tgt) = targetVariable tgt
66−targetVariable (JSIndexer _ tgt) = targetVariable tgt
67−targetVariable _ = internalError "Invalid argument to targetVariable"
68−
69−isUpdated :: String -> JS -> Bool
70−isUpdated var1 = everythingOnJS (||) check
71− where
72− check :: JS -> Bool
73− check (JSAssignment target _) | var1 == targetVariable target = True
74− check _ = False
75−
76−removeFromBlock :: ([JS] -> [JS]) -> JS -> JS
77−removeFromBlock go (JSBlock sts) = JSBlock (go sts)
78−removeFromBlock _ js = js
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hsdeleted−316
@@ -1,316 +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− inlineFnComposition,
22− etaConvert,
23− unThunk,
24− evaluateIifes
25−) where
26−
27−import Prelude ()
28−import Prelude.Compat
29−
30−import Control.Monad.Supply.Class (MonadSupply, freshName)
31−import Data.Maybe (fromMaybe)
32−
33−import Language.PureScript.CodeGen.JS.AST
34−import Language.PureScript.CodeGen.JS.Common
35−import Language.PureScript.Names
36−import Language.PureScript.CodeGen.JS.Optimizer.Common
37−import qualified Language.PureScript.Constants as C
38−
39−-- TODO: Potential bug:
40−-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
41−-- Needs to be: { 0..toFixed(10); }
42−-- Probably needs to be fixed in pretty-printer instead.
43−shouldInline :: JS -> Bool
44−shouldInline (JSVar _) = True
45−shouldInline (JSNumericLiteral _) = True
46−shouldInline (JSStringLiteral _) = True
47−shouldInline (JSBooleanLiteral _) = True
48−shouldInline (JSAccessor _ val) = shouldInline val
49−shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
50−shouldInline _ = False
51−
52−etaConvert :: JS -> JS
53−etaConvert = everywhereOnJS convert
54− where
55− convert :: JS -> JS
56− convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
57− | all shouldInline args &&
58− not (any (`isRebound` block) (map JSVar idents)) &&
59− not (any (`isRebound` block) args)
60− = JSBlock (map (replaceIdents (zip idents args)) body)
61− convert (JSFunction Nothing [] (JSBlock [JSReturn (JSApp fn [])])) = fn
62− convert js = js
63−
64−unThunk :: JS -> JS
65−unThunk = everywhereOnJS convert
66− where
67− convert :: JS -> JS
68− convert (JSBlock []) = JSBlock []
69− convert (JSBlock jss) =
70− case last jss of
71− JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
72− _ -> JSBlock jss
73− convert js = js
74−
75−evaluateIifes :: JS -> JS
76−evaluateIifes = everywhereOnJS convert
77− where
78− convert :: JS -> JS
79− convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret
80− convert js = js
81−
82−inlineVariables :: JS -> JS
83−inlineVariables = everywhereOnJS $ removeFromBlock go
84− where
85− go :: [JS] -> [JS]
86− go [] = []
87− go (JSVariableIntroduction var (Just js) : sts)
88− | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
89− go (map (replaceIdent var js) sts)
90− go (s:sts) = s : go sts
91−
92−inlineValues :: JS -> JS
93−inlineValues = everywhereOnJS convert
94− where
95− convert :: JS -> JS
96− convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
97− | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
98− | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
99− | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
100− | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
101− | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
102− convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
103− | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))
104− | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))
105− | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))
106− | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))
107− convert other = other
108− fnZero = (C.prelude, C.zero)
109− fnOne = (C.prelude, C.one)
110− fnBottom = (C.prelude, C.bottom)
111− fnTop = (C.prelude, C.top)
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 booleanAlgebraBoolean (C.&&) And
162− , binary booleanAlgebraBoolean (C.||) Or
163− , binaryFunction booleanAlgebraBoolean C.conj And
164− , binaryFunction booleanAlgebraBoolean C.disj Or
165− , unary booleanAlgebraBoolean 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−inlineFnComposition :: (Applicative m, MonadSupply m) => JS -> m JS
246−inlineFnComposition = everywhereOnJSTopDownM convert
247− where
248− convert :: (MonadSupply m) => JS -> m JS
249− convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isFnCompose dict' fn =
250− return $ JSApp x [JSApp y [z]]
251− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isFnCompose 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− isFnCompose :: JS -> JS -> Bool
256− isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn C.compose 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.prelude, C.semiringInt)
275−
276−ringNumber :: (String, String)
277−ringNumber = (C.prelude, C.ringNumber)
278−
279−ringInt :: (String, String)
280−ringInt = (C.prelude, C.ringInt)
281−
282−moduloSemiringNumber :: (String, String)
283−moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
284−
285−moduloSemiringInt :: (String, String)
286−moduloSemiringInt = (C.prelude, C.moduloSemiringInt)
287−
288−eqNumber :: (String, String)
289−eqNumber = (C.prelude, C.eqNumber)
290−
291−eqInt :: (String, String)
292−eqInt = (C.prelude, 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.prelude, 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−booleanAlgebraBoolean :: (String, String)
313−booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)
314−
315−semigroupoidFn :: (String, String)
316−semigroupoidFn = (C.prelude, C.semigroupoidFn)
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 -> 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 `elem` map identToJs [Ident C.bind, Op (C.>>=)])
85− isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && (bind `elem` [C.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 -> 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 : _) = break 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−29
@@ -1,29 +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−{-# LANGUAGE TemplateHaskell #-}
18−
19−module Language.PureScript.Comments where
20−
21−import Data.Aeson.TH
22−import qualified Data.Data as D
23−
24−data Comment
25− = LineComment String
26− | BlockComment String
27− deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
28−
29−$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Comment)
src/Language/PureScript/Constants.hsdeleted−292
@@ -1,292 +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−bind :: String
75−bind = "bind"
76−
77−unsafeIndex :: String
78−unsafeIndex = "unsafeIndex"
79−
80−(.|.) :: String
81−(.|.) = ".|."
82−
83−(.&.) :: String
84−(.&.) = ".&."
85−
86−(.^.) :: String
87−(.^.) = ".^."
88−
89−(<<<) :: String
90−(<<<) = "<<<"
91−
92−compose :: String
93−compose = "compose"
94−
95−-- Functions
96−
97−negate :: String
98−negate = "negate"
99−
100−not :: String
101−not = "not"
102−
103−conj :: String
104−conj = "conj"
105−
106−disj :: String
107−disj = "disj"
108−
109−mod :: String
110−mod = "mod"
111−
112−shl :: String
113−shl = "shl"
114−
115−shr :: String
116−shr = "shr"
117−
118−zshr :: String
119−zshr = "zshr"
120−
121−complement :: String
122−complement = "complement"
123−
124−-- Prelude Values
125−
126−zero :: String
127−zero = "zero"
128−
129−one :: String
130−one = "one"
131−
132−bottom :: String
133−bottom = "bottom"
134−
135−top :: String
136−top = "top"
137−
138−return :: String
139−return = "return"
140−
141−pure' :: String
142−pure' = "pure"
143−
144−returnEscaped :: String
145−returnEscaped = "$return"
146−
147−untilE :: String
148−untilE = "untilE"
149−
150−whileE :: String
151−whileE = "whileE"
152−
153−runST :: String
154−runST = "runST"
155−
156−stRefValue :: String
157−stRefValue = "value"
158−
159−newSTRef :: String
160−newSTRef = "newSTRef"
161−
162−readSTRef :: String
163−readSTRef = "readSTRef"
164−
165−writeSTRef :: String
166−writeSTRef = "writeSTRef"
167−
168−modifySTRef :: String
169−modifySTRef = "modifySTRef"
170−
171−mkFn :: String
172−mkFn = "mkFn"
173−
174−runFn :: String
175−runFn = "runFn"
176−
177−unit :: String
178−unit = "unit"
179−
180−-- Prim values
181−
182−undefined :: String
183−undefined = "undefined"
184−
185−-- Type Class Dictionary Names
186−
187−monadEffDictionary :: String
188−monadEffDictionary = "monadEff"
189−
190−applicativeEffDictionary :: String
191−applicativeEffDictionary = "applicativeEff"
192−
193−bindEffDictionary :: String
194−bindEffDictionary = "bindEff"
195−
196−semiringNumber :: String
197−semiringNumber = "semiringNumber"
198−
199−semiringInt :: String
200−semiringInt = "semiringInt"
201−
202−ringNumber :: String
203−ringNumber = "ringNumber"
204−
205−ringInt :: String
206−ringInt = "ringInt"
207−
208−moduloSemiringNumber :: String
209−moduloSemiringNumber = "moduloSemiringNumber"
210−
211−moduloSemiringInt :: String
212−moduloSemiringInt = "moduloSemiringInt"
213−
214−ordNumber :: String
215−ordNumber = "ordNumber"
216−
217−ordInt :: String
218−ordInt = "ordInt"
219−
220−eqNumber :: String
221−eqNumber = "eqNumber"
222−
223−eqInt :: String
224−eqInt = "eqInt"
225−
226−eqString :: String
227−eqString = "eqString"
228−
229−eqBoolean :: String
230−eqBoolean = "eqBoolean"
231−
232−boundedBoolean :: String
233−boundedBoolean = "boundedBoolean"
234−
235−booleanAlgebraBoolean :: String
236−booleanAlgebraBoolean = "booleanAlgebraBoolean"
237−
238−semigroupString :: String
239−semigroupString = "semigroupString"
240−
241−semigroupoidFn :: String
242−semigroupoidFn = "semigroupoidFn"
243−
244−-- Generic Deriving
245−
246−generic :: String
247−generic = "Generic"
248−
249−toSpine :: String
250−toSpine = "toSpine"
251−
252−fromSpine :: String
253−fromSpine = "fromSpine"
254−
255−toSignature :: String
256−toSignature = "toSignature"
257−
258−-- Main module
259−
260−main :: String
261−main = "main"
262−
263−-- Code Generation
264−
265−__superclass_ :: String
266−__superclass_ = "__superclass_"
267−
268−__unused :: String
269−__unused = "__unused"
270−
271−-- Modules
272−
273−prim :: String
274−prim = "Prim"
275−
276−prelude :: String
277−prelude = "Prelude"
278−
279−dataArrayUnsafe :: String
280−dataArrayUnsafe = "Data_Array_Unsafe"
281−
282−eff :: String
283−eff = "Control_Monad_Eff"
284−
285−st :: String
286−st = "Control_Monad_ST"
287−
288−dataFunction :: String
289−dataFunction = "Data_Function"
290−
291−dataIntBits :: String
292−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−37
@@ -1,37 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveFunctor #-}
3−
4−-- |
5−-- The core functional representation for binders
6−--
7−module Language.PureScript.CoreFn.Binders where
8−
9−import qualified Data.Data as D
10−
11−import Language.PureScript.CoreFn.Literals
12−import Language.PureScript.Names
13−
14−-- |
15−-- Data type for binders
16−--
17−data Binder a
18− -- |
19− -- Wildcard binder
20− --
21− = NullBinder a
22− -- |
23− -- A binder which matches a literal value
24− --
25− | LiteralBinder a (Literal (Binder a))
26− -- |
27− -- A binder which binds an identifier
28− --
29− | VarBinder a Ident
30− -- |
31− -- A binder which matches a data constructor
32− --
33− | ConstructorBinder a (Qualified (ProperName 'TypeName)) (Qualified (ProperName 'ConstructorName)) [Binder a]
34− -- |
35− -- A binder which binds its input to an identifier
36− --
37− | NamedBinder a Ident (Binder a) deriving (Show, Read, D.Data, D.Typeable, Functor)
src/Language/PureScript/CoreFn/Desugar.hsdeleted−265
@@ -1,265 +0,0 @@
1−module Language.PureScript.CoreFn.Desugar (moduleToCoreFn) where
2−
3−import Data.Function (on)
4−import Data.List (sort, sortBy, nub)
5−import Data.Maybe (mapMaybe)
6−import qualified Data.Map as M
7−
8−import Control.Arrow (second, (***))
9−
10−import Language.PureScript.Crash
11−import Language.PureScript.AST.SourcePos
12−import Language.PureScript.AST.Traversals
13−import Language.PureScript.CoreFn.Ann
14−import Language.PureScript.CoreFn.Binders
15−import Language.PureScript.CoreFn.Expr
16−import Language.PureScript.CoreFn.Literals
17−import Language.PureScript.CoreFn.Meta
18−import Language.PureScript.CoreFn.Module
19−import Language.PureScript.Environment
20−import Language.PureScript.Names
21−import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDictionaryNames)
22−import Language.PureScript.Types
23−import Language.PureScript.Comments
24−import qualified Language.PureScript.AST as A
25−
26−-- |
27−-- Desugars a module from AST to CoreFn representation.
28−--
29−moduleToCoreFn :: Environment -> A.Module -> Module Ann
30−moduleToCoreFn _ (A.Module _ _ _ _ Nothing) =
31− internalError "Module exports were not elaborated before moduleToCoreFn"
32−moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =
33− let imports = nub $ mapMaybe importToCoreFn decls ++ findQualModules decls
34− exps' = nub $ concatMap exportToCoreFn exps
35− externs = nub $ mapMaybe externToCoreFn decls
36− decls' = concatMap (declToCoreFn Nothing []) decls
37− in Module coms mn imports exps' externs decls'
38−
39− where
40−
41− -- |
42− -- Desugars member declarations from AST to CoreFn representation.
43− --
44− declToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Declaration -> [Bind Ann]
45− declToCoreFn ss com (A.DataDeclaration Newtype _ _ [(ctor, _)]) =
46− [NonRec (properToIdent ctor) $
47− Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var nullAnn $ Qualified Nothing (Ident "x"))]
48− declToCoreFn _ _ d@(A.DataDeclaration Newtype _ _ _) =
49− error $ "Found newtype with multiple constructors: " ++ show d
50− declToCoreFn ss com (A.DataDeclaration Data tyName _ ctors) =
51− flip map ctors $ \(ctor, _) ->
52− let (_, _, _, fields) = lookupConstructor env (Qualified (Just mn) ctor)
53− in NonRec (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields
54− declToCoreFn ss _ (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn ss []) ds
55− declToCoreFn ss com (A.ValueDeclaration name _ _ (Right e)) =
56− [NonRec name (exprToCoreFn ss com Nothing e)]
57− declToCoreFn ss com (A.FixityDeclaration _ name (Just alias)) =
58− [NonRec (Op name) (Var (ss, com, Nothing, getValueMeta alias) alias)]
59− declToCoreFn ss _ (A.BindingGroupDeclaration ds) =
60− [Rec $ map (\(name, _, e) -> (name, exprToCoreFn ss [] Nothing e)) ds]
61− declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =
62− [NonRec (properToIdent name) $ mkTypeClassConstructor ss com supers members]
63− declToCoreFn _ com (A.PositionedDeclaration ss com1 d) =
64− declToCoreFn (Just ss) (com ++ com1) d
65− declToCoreFn _ _ _ = []
66−
67− -- |
68− -- Desugars expressions from AST to CoreFn representation.
69− --
70− exprToCoreFn :: Maybe SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann
71− exprToCoreFn ss com ty (A.NumericLiteral v) =
72− Literal (ss, com, ty, Nothing) (NumericLiteral v)
73− exprToCoreFn ss com ty (A.StringLiteral v) =
74− Literal (ss, com, ty, Nothing) (StringLiteral v)
75− exprToCoreFn ss com ty (A.CharLiteral v) =
76− Literal (ss, com, ty, Nothing) (CharLiteral v)
77− exprToCoreFn ss com ty (A.BooleanLiteral v) =
78− Literal (ss, com, ty, Nothing) (BooleanLiteral v)
79− exprToCoreFn ss com ty (A.ArrayLiteral vs) =
80− Literal (ss, com, ty, Nothing) (ArrayLiteral $ map (exprToCoreFn ss [] Nothing) vs)
81− exprToCoreFn ss com ty (A.ObjectLiteral vs) =
82− Literal (ss, com, ty, Nothing) (ObjectLiteral $ map (second (exprToCoreFn ss [] Nothing)) vs)
83− exprToCoreFn ss com ty (A.Accessor name v) =
84− Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
85− exprToCoreFn ss com ty (A.ObjectUpdate obj vs) =
86− ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ map (second (exprToCoreFn ss [] Nothing)) vs
87− exprToCoreFn ss com ty (A.Abs (Left name) v) =
88− Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
89− exprToCoreFn _ _ _ (A.Abs _ _) =
90− internalError "Abs with Binder argument was not desugared before exprToCoreFn mn"
91− exprToCoreFn ss com ty (A.App v1 v2) =
92− App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)
93− exprToCoreFn ss com ty (A.Var ident) =
94− Var (ss, com, ty, getValueMeta ident) ident
95− exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =
96− Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]
97− [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]
98− (Right $ exprToCoreFn Nothing [] Nothing v2)
99− , CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral False]
100− (Right $ exprToCoreFn Nothing [] Nothing v3) ]
101− exprToCoreFn ss com ty (A.Constructor name) =
102− Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name
103− exprToCoreFn ss com ty (A.Case vs alts) =
104− Case (ss, com, ty, Nothing) (map (exprToCoreFn ss [] Nothing) vs) (map (altToCoreFn ss) alts)
105− exprToCoreFn ss com _ (A.TypedValue _ v ty) =
106− exprToCoreFn ss com (Just ty) v
107− exprToCoreFn ss com ty (A.Let ds v) =
108− Let (ss, com, ty, Nothing) (concatMap (declToCoreFn ss []) ds) (exprToCoreFn ss [] Nothing v)
109− exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ (A.ObjectLiteral vs) _)) =
110− let args = map (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs
111− ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)
112− in foldl (App (ss, com, Nothing, Nothing)) ctor args
113− exprToCoreFn ss com ty (A.TypeClassDictionaryAccessor _ ident) =
114− Abs (ss, com, ty, Nothing) (Ident "dict")
115− (Accessor nullAnn (runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))
116− exprToCoreFn _ com ty (A.PositionedValue ss com1 v) =
117− exprToCoreFn (Just ss) (com ++ com1) ty v
118− exprToCoreFn _ _ _ e =
119− error $ "Unexpected value in exprToCoreFn mn: " ++ show e
120−
121− -- |
122− -- Desugars case alternatives from AST to CoreFn representation.
123− --
124− altToCoreFn :: Maybe SourceSpan -> A.CaseAlternative -> CaseAlternative Ann
125− altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn ss []) bs) (go vs)
126− where
127− go :: Either [(A.Guard, A.Expr)] A.Expr -> Either [(Guard Ann, Expr Ann)] (Expr Ann)
128− go (Left ges) = Left $ map (exprToCoreFn ss [] Nothing *** exprToCoreFn ss [] Nothing) ges
129− go (Right e) = Right (exprToCoreFn ss [] Nothing e)
130−
131− -- |
132− -- Desugars case binders from AST to CoreFn representation.
133− --
134− binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann
135− binderToCoreFn ss com (A.NullBinder) =
136− NullBinder (ss, com, Nothing, Nothing)
137− binderToCoreFn ss com (A.BooleanBinder b) =
138− LiteralBinder (ss, com, Nothing, Nothing) (BooleanLiteral b)
139− binderToCoreFn ss com (A.StringBinder s) =
140− LiteralBinder (ss, com, Nothing, Nothing) (StringLiteral s)
141− binderToCoreFn ss com (A.CharBinder c) =
142− LiteralBinder (ss, com, Nothing, Nothing) (CharLiteral c)
143− binderToCoreFn ss com (A.NumberBinder n) =
144− LiteralBinder (ss, com, Nothing, Nothing) (NumericLiteral n)
145− binderToCoreFn ss com (A.VarBinder name) =
146− VarBinder (ss, com, Nothing, Nothing) name
147− binderToCoreFn ss com (A.ConstructorBinder dctor@(Qualified mn' _) bs) =
148− let (_, tctor, _, _) = lookupConstructor env dctor
149− in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (map (binderToCoreFn ss []) bs)
150− binderToCoreFn ss com (A.ObjectBinder bs) =
151− LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn ss [])) bs)
152− binderToCoreFn ss com (A.ArrayBinder bs) =
153− LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn ss []) bs)
154− binderToCoreFn ss com (A.NamedBinder name b) =
155− NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)
156− binderToCoreFn _ com (A.PositionedBinder ss com1 b) =
157− binderToCoreFn (Just ss) (com ++ com1) b
158− binderToCoreFn ss com (A.TypedBinder _ b) =
159− binderToCoreFn ss com b
160−
161− -- |
162− -- Gets metadata for values.
163− --
164− getValueMeta :: Qualified Ident -> Maybe Meta
165− getValueMeta name =
166− case lookupValue env name of
167− Just (_, External, _) -> Just IsForeign
168− _ -> Nothing
169−
170− -- |
171− -- Gets metadata for data constructors.
172− --
173− getConstructorMeta :: Qualified (ProperName 'ConstructorName) -> Meta
174− getConstructorMeta ctor =
175− case lookupConstructor env ctor of
176− (Newtype, _, _, _) -> IsNewtype
177− dc@(Data, _, _, fields) ->
178− let constructorType = if numConstructors (ctor, dc) == 1 then ProductType else SumType
179− in IsConstructor constructorType fields
180− where
181−
182− numConstructors
183− :: (Qualified (ProperName 'ConstructorName), (DataDeclType, ProperName 'TypeName, Type, [Ident]))
184− -> Int
185− numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors env
186−
187− typeConstructor
188− :: (Qualified (ProperName 'ConstructorName), (DataDeclType, ProperName 'TypeName, Type, [Ident]))
189− -> (ModuleName, ProperName 'TypeName)
190− typeConstructor (Qualified (Just mn') _, (_, tyCtor, _, _)) = (mn', tyCtor)
191− typeConstructor _ = internalError "Invalid argument to typeConstructor"
192−
193−-- |
194−-- Find module names from qualified references to values. This is used to
195−-- ensure instances are imported from any module that is referenced by the
196−-- current module, not just from those that are imported explicitly (#667).
197−--
198−findQualModules :: [A.Declaration] -> [ModuleName]
199−findQualModules decls =
200− let (f, _, _, _, _) = everythingOnValues (++) fqDecls fqValues fqBinders (const []) (const [])
201− in f `concatMap` decls
202− where
203− fqDecls :: A.Declaration -> [ModuleName]
204− fqDecls (A.TypeInstanceDeclaration _ _ (Qualified (Just mn) _) _ _) = [mn]
205− fqDecls (A.FixityDeclaration _ _ (Just (Qualified (Just mn) _))) = [mn]
206− fqDecls _ = []
207−
208− fqValues :: A.Expr -> [ModuleName]
209− fqValues (A.Var (Qualified (Just mn) _)) = [mn]
210− fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]
211− fqValues _ = []
212−
213− fqBinders :: A.Binder -> [ModuleName]
214− fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]
215− fqBinders _ = []
216−
217−-- |
218−-- Desugars import declarations from AST to CoreFn representation.
219−--
220−importToCoreFn :: A.Declaration -> Maybe ModuleName
221−importToCoreFn (A.ImportDeclaration name _ _ _) = Just name
222−importToCoreFn (A.PositionedDeclaration _ _ d) = importToCoreFn d
223−importToCoreFn _ = Nothing
224−
225−-- |
226−-- Desugars foreign declarations from AST to CoreFn representation.
227−--
228−externToCoreFn :: A.Declaration -> Maybe ForeignDecl
229−externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)
230−externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d
231−externToCoreFn _ = Nothing
232−
233−-- |
234−-- Desugars export declarations references from AST to CoreFn representation.
235−-- CoreFn modules only export values, so all data constructors, class
236−-- constructor, instances and values are flattened into one list.
237−--
238−exportToCoreFn :: A.DeclarationRef -> [Ident]
239−exportToCoreFn (A.TypeRef _ (Just dctors)) = map properToIdent dctors
240−exportToCoreFn (A.ValueRef name) = [name]
241−exportToCoreFn (A.TypeClassRef name) = [properToIdent name]
242−exportToCoreFn (A.TypeInstanceRef name) = [name]
243−exportToCoreFn (A.PositionedDeclarationRef _ _ d) = exportToCoreFn d
244−exportToCoreFn _ = []
245−
246−-- |
247−-- Makes a typeclass dictionary constructor function. The returned expression
248−-- is a function that accepts the superclass instances and member
249−-- implementations and returns a record for the instance dictionary.
250−--
251−mkTypeClassConstructor :: Maybe SourceSpan -> [Comment] -> [Constraint] -> [A.Declaration] -> Expr Ann
252−mkTypeClassConstructor ss com [] [] = Literal (ss, com, Nothing, Just IsTypeClassConstructor) (ObjectLiteral [])
253−mkTypeClassConstructor ss com supers members =
254− let args@(a:as) = sort $ map typeClassMemberName members ++ superClassDictionaryNames supers
255− props = [ (arg, Var nullAnn $ Qualified Nothing (Ident arg)) | arg <- args ]
256− dict = Literal nullAnn (ObjectLiteral props)
257− in Abs (ss, com, Nothing, Just IsTypeClassConstructor)
258− (Ident a)
259− (foldr (Abs nullAnn . Ident) dict as)
260−
261−-- |
262−-- Converts a ProperName to an Ident.
263−--
264−properToIdent :: ProperName a -> Ident
265−properToIdent = Ident . runProperName
src/Language/PureScript/CoreFn/Expr.hsdeleted−123
@@ -1,123 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveFunctor #-}
3−
4−-- |
5−-- The core functional representation
6−--
7−module Language.PureScript.CoreFn.Expr where
8−
9−import Control.Arrow ((***))
10−
11−import qualified Data.Data as D
12−
13−import Language.PureScript.CoreFn.Binders
14−import Language.PureScript.CoreFn.Literals
15−import Language.PureScript.Names
16−
17−-- |
18−-- Data type for expressions and terms
19−--
20−data Expr a
21− -- |
22− -- A literal value
23− --
24− = Literal a (Literal (Expr a))
25− -- |
26− -- A data constructor (type name, constructor name, field names)
27− --
28− | Constructor a (ProperName 'TypeName) (ProperName 'ConstructorName) [Ident]
29− -- |
30− -- A record property accessor
31− --
32− | Accessor a String (Expr a)
33− -- |
34− -- Partial record update
35− --
36− | ObjectUpdate a (Expr a) [(String, Expr a)]
37− -- |
38− -- Function introduction
39− --
40− | Abs a Ident (Expr a)
41− -- |
42− -- Function application
43− --
44− | App a (Expr a) (Expr a)
45− -- |
46− -- Variable
47− --
48− | Var a (Qualified Ident)
49− -- |
50− -- A case expression
51− --
52− | Case a [Expr a] [CaseAlternative a]
53− -- |
54− -- A let binding
55− --
56− | Let a [Bind a] (Expr a) deriving (Show, Read, D.Data, D.Typeable, Functor)
57−
58−-- |
59−-- A let or module binding.
60−--
61−data Bind a
62− -- |
63− -- Non-recursive binding for a single value
64− --
65− = NonRec Ident (Expr a)
66− -- |
67− -- Mutually recursive binding group for several values
68− --
69− | Rec [(Ident, Expr a)] deriving (Show, Read, D.Data, D.Typeable, Functor)
70−
71−-- |
72−-- A guard is just a boolean-valued expression that appears alongside a set of binders
73−--
74−type Guard a = Expr a
75−
76−-- |
77−-- An alternative in a case statement
78−--
79−data CaseAlternative a = CaseAlternative
80− { -- |
81− -- A collection of binders with which to match the inputs
82− --
83− caseAlternativeBinders :: [Binder a]
84− -- |
85− -- The result expression or a collect of guarded expressions
86− --
87− , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
88− } deriving (Show, Read, D.Data, D.Typeable)
89−
90−instance Functor CaseAlternative where
91−
92− fmap f (CaseAlternative cabs car) = CaseAlternative
93− (fmap (fmap f) cabs)
94− (either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)
95−
96−-- |
97−-- Extract the annotation from a term
98−--
99−extractAnn :: Expr a -> a
100−extractAnn (Literal a _) = a
101−extractAnn (Constructor a _ _ _) = a
102−extractAnn (Accessor a _ _) = a
103−extractAnn (ObjectUpdate a _ _) = a
104−extractAnn (Abs a _ _) = a
105−extractAnn (App a _ _) = a
106−extractAnn (Var a _) = a
107−extractAnn (Case a _ _) = a
108−extractAnn (Let a _ _) = a
109−
110−
111−-- |
112−-- Modify the annotation on a term
113−--
114−modifyAnn :: (a -> a) -> Expr a -> Expr a
115−modifyAnn f (Literal a b) = Literal (f a) b
116−modifyAnn f (Constructor a b c d) = Constructor (f a) b c d
117−modifyAnn f (Accessor a b c) = Accessor (f a) b c
118−modifyAnn f (ObjectUpdate a b c) = ObjectUpdate (f a) b c
119−modifyAnn f (Abs a b c) = Abs (f a) b c
120−modifyAnn f (App a b c) = App (f a) b c
121−modifyAnn f (Var a b) = Var (f a) b
122−modifyAnn f (Case a b c) = Case (f a) b c
123−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, Read, 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, Read, 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, Read, 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, Read)
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/Crash.hsdeleted−9
@@ -1,9 +0,0 @@
1−module Language.PureScript.Crash where
2−
3−-- | Exit with an error message and a crash report link.
4−internalError :: String -> a
5−internalError =
6− error
7− . ("An internal error ocurred during compilation: " ++)
8− . (++ "\nPlease report this at https://github.com/purescript/purescript/issues")
9− . show
src/Language/PureScript/Docs.hsdeleted−14
@@ -1,14 +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.Convert as Docs
13−import Language.PureScript.Docs.Render as Docs
14−import Language.PureScript.Docs.ParseAndDesugar as Docs
src/Language/PureScript/Docs/AsMarkdown.hsdeleted−125
@@ -1,125 +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.Convert as Convert
16−import qualified Language.PureScript.Docs.Render as Render
17−
18−-- |
19−-- Take a list of modules and render them all in order, returning a single
20−-- Markdown-formatted String.
21−--
22−renderModulesAsMarkdown :: [P.Module] -> String
23−renderModulesAsMarkdown =
24− runDocs . modulesAsMarkdown . map Convert.convertModule
25−
26−modulesAsMarkdown :: [Module] -> Docs
27−modulesAsMarkdown = mapM_ moduleAsMarkdown
28−
29−moduleAsMarkdown :: Module -> Docs
30−moduleAsMarkdown Module{..} = do
31− headerLevel 2 $ "Module " ++ modName
32− spacer
33− for_ modComments tell'
34− mapM_ (declAsMarkdown modName) modDeclarations
35− spacer
36−
37−declAsMarkdown :: String -> Declaration -> Docs
38−declAsMarkdown mn decl@Declaration{..} = do
39− let options = defaultRenderTypeOptions { currentModule = Just (P.moduleNameFromString mn) }
40− headerLevel 4 (ticks declTitle)
41− spacer
42−
43− let (instances, children) = partition (isChildInstance . cdeclInfo) declChildren
44− fencedBlock $ do
45− tell' (codeToString $ Render.renderDeclarationWithOptions options decl)
46− zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children
47− spacer
48−
49− for_ declFixity (\fixity -> fixityAsMarkdown fixity >> spacer)
50−
51− for_ declComments tell'
52−
53− unless (null instances) $ do
54− headerLevel 5 "Instances"
55− fencedBlock $ mapM_ (tell' . childToString NotFirst) instances
56− spacer
57−
58− where
59− isChildInstance (ChildInstance _ _) = True
60− isChildInstance _ = False
61−
62−codeToString :: RenderedCode -> String
63−codeToString = outputWith elemAsMarkdown
64− where
65− elemAsMarkdown (Syntax x) = x
66− elemAsMarkdown (Ident x) = x
67− elemAsMarkdown (Ctor x _) = x
68− elemAsMarkdown (Kind x) = x
69− elemAsMarkdown (Keyword x) = x
70− elemAsMarkdown Space = " "
71−
72−fixityAsMarkdown :: P.Fixity -> Docs
73−fixityAsMarkdown (P.Fixity associativity precedence) =
74− tell' $ concat [ "_"
75− , associativityStr
76− , " / precedence "
77− , show precedence
78− , "_"
79− ]
80− where
81− associativityStr = case associativity of
82− P.Infixl -> "left-associative"
83− P.Infixr -> "right-associative"
84− P.Infix -> "non-associative"
85−
86−childToString :: First -> ChildDeclaration -> String
87−childToString f decl@ChildDeclaration{..} =
88− case cdeclInfo of
89− ChildDataConstructor _ ->
90− let c = if f == First then "=" else "|"
91− in " " ++ c ++ " " ++ str
92− ChildTypeClassMember _ ->
93− " " ++ str
94− ChildInstance _ _ ->
95− str
96− where
97− str = codeToString $ Render.renderChildDeclaration decl
98−
99−data First
100− = First
101− | NotFirst
102− deriving (Show, Read, Eq, Ord)
103−
104−type Docs = Writer [String] ()
105−
106−runDocs :: Docs -> String
107−runDocs = unlines . execWriter
108−
109−tell' :: String -> Docs
110−tell' = tell . (:[])
111−
112−spacer :: Docs
113−spacer = tell' ""
114−
115−headerLevel :: Int -> String -> Docs
116−headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)
117−
118−fencedBlock :: Docs -> Docs
119−fencedBlock inner = do
120− tell' "``` purescript"
121− inner
122− tell' "```"
123−
124−ticks :: String -> String
125−ticks = ("`" ++) . (++ "`")
src/Language/PureScript/Docs/Convert.hsdeleted−231
@@ -1,231 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE ViewPatterns #-}
5−
6−-- | Functions for converting PureScript ASTs into values of the data types
7−-- from Language.PureScript.Docs.
8−
9−module Language.PureScript.Docs.Convert
10− ( convertModule
11− , collectBookmarks
12− ) where
13−
14−import Prelude ()
15−import Prelude.Compat
16−
17−import Control.Monad
18−import Control.Category ((>>>))
19−import Data.Either
20−import Data.Maybe (mapMaybe, isNothing)
21−import Data.List (nub, isPrefixOf, isSuffixOf)
22−
23−import qualified Language.PureScript as P
24−
25−import Language.PureScript.Docs.Types
26−
27−-- |
28−-- Convert a single Module.
29−--
30−convertModule :: P.Module -> Module
31−convertModule m@(P.Module _ coms moduleName _ _) =
32− Module (P.runModuleName moduleName) comments (declarations m)
33− where
34− comments = convertComments coms
35− declarations =
36− P.exportedDeclarations
37− >>> mapMaybe (\d -> getDeclarationTitle d >>= convertDeclaration d)
38− >>> augmentDeclarations
39− >>> map addDefaultFixity
40−
41−-- | The data type for an intermediate stage which we go through during
42−-- converting.
43−--
44−-- In the first pass, we take all top level declarations in the module, and
45−-- collect other information which will later be used to augment the top level
46−-- declarations. These two situation correspond to the Right and Left
47−-- constructors, respectively.
48−--
49−-- In the second pass, we go over all of the Left values and augment the
50−-- relevant declarations, leaving only the augmented Right values.
51−--
52−-- Note that in the Left case, we provide a [String] as well as augment
53−-- information. The [String] value should be a list of titles of declarations
54−-- that the augmentation should apply to. For example, for a type instance
55−-- declaration, that would be any types or type classes mentioned in the
56−-- instance. For a fixity declaration, it would be just the relevant operator's
57−-- name.
58−type IntermediateDeclaration
59− = Either ([String], DeclarationAugment) Declaration
60−
61−-- | Some data which will be used to augment a Declaration in the
62−-- output.
63−--
64−-- The AugmentChild constructor allows us to move all children under their
65−-- respective parents. It is only necessary for type instance declarations,
66−-- since they appear at the top level in the AST, and since they might need to
67−-- appear as children in two places (for example, if a data type defined in a
68−-- module is an instance of a type class also defined in that module).
69−--
70−-- The AugmentFixity constructor allows us to augment operator definitions
71−-- with their associativity and precedence.
72−data DeclarationAugment
73− = AugmentChild ChildDeclaration
74− | AugmentFixity P.Fixity
75−
76−-- | Augment top-level declarations; the second pass. See the comments under
77−-- the type synonym IntermediateDeclaration for more information.
78−augmentDeclarations :: [IntermediateDeclaration] -> [Declaration]
79−augmentDeclarations (partitionEithers -> (augments, toplevels)) =
80− foldl go toplevels augments
81− where
82− go ds (parentTitles, a) =
83− map (\d ->
84− if declTitle d `elem` parentTitles
85− then augmentWith a d
86− else d) ds
87−
88− augmentWith a d =
89− case a of
90− AugmentChild child ->
91− d { declChildren = declChildren d ++ [child] }
92− AugmentFixity fixity ->
93− d { declFixity = Just fixity }
94−
95−-- | Add the default operator fixity for operators which do not have associated
96−-- fixity declarations.
97−--
98−-- TODO: This may no longer be necessary after issue 806 is resolved, hopefully
99−-- in 0.9.
100−addDefaultFixity :: Declaration -> Declaration
101−addDefaultFixity decl@Declaration{..}
102− | isOp declTitle && isNothing declFixity =
103− decl { declFixity = Just defaultFixity }
104− | otherwise =
105− decl
106− where
107− isOp :: String -> Bool
108− isOp str = "(" `isPrefixOf` str && ")" `isSuffixOf` str
109− defaultFixity = P.Fixity P.Infixl (-1)
110−
111−getDeclarationTitle :: P.Declaration -> Maybe String
112−getDeclarationTitle (P.TypeDeclaration name _) = Just (P.showIdent name)
113−getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)
114−getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)
115−getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)
116−getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)
117−getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (P.runProperName name)
118−getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)
119−getDeclarationTitle (P.FixityDeclaration _ name _) = Just ("(" ++ name ++ ")")
120−getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d
121−getDeclarationTitle _ = Nothing
122−
123−-- | Create a basic Declaration value.
124−mkDeclaration :: String -> DeclarationInfo -> Declaration
125−mkDeclaration title info =
126− Declaration { declTitle = title
127− , declComments = Nothing
128− , declSourceSpan = Nothing
129− , declChildren = []
130− , declFixity = Nothing
131− , declInfo = info
132− }
133−
134−basicDeclaration :: String -> DeclarationInfo -> Maybe IntermediateDeclaration
135−basicDeclaration title info = Just $ Right $ mkDeclaration title info
136−
137−convertDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration
138−convertDeclaration (P.TypeDeclaration _ ty) title =
139− basicDeclaration title (ValueDeclaration ty)
140−convertDeclaration (P.ExternDeclaration _ ty) title =
141− basicDeclaration title (ValueDeclaration ty)
142−convertDeclaration (P.DataDeclaration dtype _ args ctors) title =
143− Just (Right (mkDeclaration title info) { declChildren = children })
144− where
145− info = DataDeclaration dtype args
146− children = map convertCtor ctors
147− convertCtor (ctor', tys) =
148− ChildDeclaration (P.runProperName ctor') Nothing Nothing (ChildDataConstructor tys)
149−convertDeclaration (P.ExternDataDeclaration _ kind') title =
150− basicDeclaration title (ExternDataDeclaration kind')
151−convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =
152− basicDeclaration title (TypeSynonymDeclaration args ty)
153−convertDeclaration (P.TypeClassDeclaration _ args implies ds) title =
154− Just (Right (mkDeclaration title info) { declChildren = children })
155− where
156− info = TypeClassDeclaration args implies
157− children = map convertClassMember ds
158− convertClassMember (P.PositionedDeclaration _ _ d) =
159− convertClassMember d
160− convertClassMember (P.TypeDeclaration ident' ty) =
161− ChildDeclaration (P.showIdent ident') Nothing Nothing (ChildTypeClassMember ty)
162− convertClassMember _ =
163− P.internalError "convertDeclaration: Invalid argument to convertClassMember."
164−convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title =
165− Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))
166− where
167− classNameString = unQual className
168− typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)
169− unQual x = let (P.Qualified _ y) = x in P.runProperName y
170−
171− extractProperNames (P.TypeConstructor n) = [unQual n]
172− extractProperNames _ = []
173−
174− childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)
175− classApp = foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName className)) tys
176−convertDeclaration (P.FixityDeclaration fixity _ Nothing) title =
177− Just (Left ([title], AugmentFixity fixity))
178−convertDeclaration (P.FixityDeclaration fixity _ (Just alias)) title =
179− Just $ Right $ (mkDeclaration title (AliasDeclaration alias fixity)) { declFixity = Just fixity }
180−convertDeclaration (P.PositionedDeclaration srcSpan com d') title =
181− fmap (addComments . addSourceSpan) (convertDeclaration d' title)
182− where
183− addComments (Right d) =
184− Right (d { declComments = convertComments com })
185− addComments (Left augment) =
186− Left (withAugmentChild (\d -> d { cdeclComments = convertComments com })
187− augment)
188−
189− addSourceSpan (Right d) =
190− Right (d { declSourceSpan = Just srcSpan })
191− addSourceSpan (Left augment) =
192− Left (withAugmentChild (\d -> d { cdeclSourceSpan = Just srcSpan })
193− augment)
194−
195− withAugmentChild f (t, a) =
196− case a of
197− AugmentChild d -> (t, AugmentChild (f d))
198− _ -> (t, a)
199−convertDeclaration _ _ = Nothing
200−
201−convertComments :: [P.Comment] -> Maybe String
202−convertComments cs = do
203− let raw = concatMap toLines cs
204− guard (all hasPipe raw && not (null raw))
205− return (go raw)
206− where
207− go = unlines . map stripPipes
208−
209− toLines (P.LineComment s) = [s]
210− toLines (P.BlockComment s) = lines s
211−
212− hasPipe s = case dropWhile (== ' ') s of { ('|':_) -> True; _ -> False }
213−
214− stripPipes = dropPipe . dropWhile (== ' ')
215−
216− dropPipe ('|':' ':s) = s
217− dropPipe ('|':s) = s
218− dropPipe s = s
219−
220−-- | Go through a PureScript module and extract a list of Bookmarks; references
221−-- to data types or values, to be used as a kind of index. These are used for
222−-- generating links in the HTML documentation, for example.
223−collectBookmarks :: InPackage P.Module -> [Bookmark]
224−collectBookmarks (Local m) = map Local (collectBookmarks' m)
225−collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)
226−
227−collectBookmarks' :: P.Module -> [(P.ModuleName, String)]
228−collectBookmarks' m =
229− map (P.getModuleName m, )
230− (mapMaybe getDeclarationTitle
231− (P.exportedDeclarations m))
src/Language/PureScript/Docs/ParseAndDesugar.hsdeleted−129
@@ -1,129 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−
3−module Language.PureScript.Docs.ParseAndDesugar
4− ( parseAndDesugar
5− ) where
6−
7−import Prelude ()
8−import Prelude.Compat
9−
10−import qualified Data.Map as M
11−import Control.Arrow (first)
12−import Control.Monad
13−
14−import Control.Monad.Trans.Except
15−import Control.Monad.Writer.Strict (runWriterT)
16−import Control.Monad.Error.Class (MonadError(..))
17−import Control.Monad.IO.Class (MonadIO(..))
18−
19−import Web.Bower.PackageMeta (PackageName)
20−
21−import qualified Language.PureScript as P
22−import qualified Language.PureScript.Constants as C
23−import Language.PureScript.Docs.Types
24−import Language.PureScript.Docs.Convert (collectBookmarks)
25−
26−-- |
27−-- Given:
28−--
29−-- * A list of local source files
30−-- * A list of source files from external dependencies, together with their
31−-- package names
32−-- * A callback, taking a list of bookmarks, and a list of desugared modules
33−--
34−-- This function does the following:
35−--
36−-- * Parse all of the input and dependency source files
37−-- * Partially desugar all of the resulting modules
38−-- * Collect a list of bookmarks from the whole set of source files
39−-- * Collect a list of desugared modules from just the input source files (not
40−-- dependencies)
41−-- * Call the callback with the bookmarks and desugared module list.
42−parseAndDesugar ::
43− [FilePath]
44− -> [(PackageName, FilePath)]
45− -> ([Bookmark] -> [P.Module] -> IO a)
46− -> IO (Either P.MultipleErrors a)
47−parseAndDesugar inputFiles depsFiles callback = do
48− inputFiles' <- traverse (parseAs Local) inputFiles
49− depsFiles' <- traverse (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles
50−
51− runExceptT $ do
52− ms <- parseFiles (inputFiles' ++ depsFiles')
53− ms' <- sortModules (map snd ms)
54− (bs, ms'') <- desugarWithBookmarks ms ms'
55− liftIO $ callback bs ms''
56−
57−parseFiles ::
58− [(FileInfo, FilePath)]
59− -> ExceptT P.MultipleErrors IO [(FileInfo, P.Module)]
60−parseFiles =
61− throwLeft . P.parseModulesFromFiles fileInfoToString
62−
63−sortModules ::
64− [P.Module]
65− -> ExceptT P.MultipleErrors IO [P.Module]
66−sortModules =
67− fmap fst . throwLeft . sortModules' . map importPrim
68− where
69− sortModules' :: [P.Module] -> Either P.MultipleErrors ([P.Module], P.ModuleGraph)
70− sortModules' = P.sortModules
71−
72−desugarWithBookmarks ::
73− [(FileInfo, P.Module)]
74− -> [P.Module]
75− -> ExceptT P.MultipleErrors IO ([Bookmark], [P.Module])
76−desugarWithBookmarks msInfo msSorted = do
77− msDesugared <- throwLeft (desugar msSorted)
78−
79− let msDeps = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) msInfo)
80− msPackages = map (addPackage msDeps) msDesugared
81− bookmarks = concatMap collectBookmarks msPackages
82−
83− return (bookmarks, takeLocals msPackages)
84−
85−throwLeft :: (MonadError l m) => Either l r -> m r
86−throwLeft = either throwError return
87−
88−-- | Specifies whether a PureScript source file is considered as:
89−--
90−-- 1) with the `Local` constructor, a target source file, i.e., we want to see
91−-- its modules in the output
92−-- 2) with the `FromDep` constructor, a dependencies source file, i.e. we do
93−-- not want its modules in the output; it is there to enable desugaring, and
94−-- to ensure that links between modules are constructed correctly.
95−type FileInfo = InPackage FilePath
96−
97−fileInfoToString :: FileInfo -> FilePath
98−fileInfoToString (Local fn) = fn
99−fileInfoToString (FromDep _ fn) = fn
100−
101−importPrim :: P.Module -> P.Module
102−importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])
103−
104−desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]
105−desugar = P.evalSupplyT 0 . desugar'
106− where
107− desugar' :: [P.Module] -> P.SupplyT (Either P.MultipleErrors) [P.Module]
108− desugar' = traverse P.desugarDoModule >=> P.desugarCasesModule >=> ignoreWarnings . P.desugarImports []
109− ignoreWarnings m = liftM fst (runWriterT m)
110−
111−parseFile :: FilePath -> IO (FilePath, String)
112−parseFile input' = (,) input' <$> readFile input'
113−
114−parseAs :: (FilePath -> a) -> FilePath -> IO (a, String)
115−parseAs g = fmap (first g) . parseFile
116−
117−getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName
118−getDepsModuleNames = foldl go M.empty
119− where
120− go deps p = deps # case p of
121− Local _ -> id
122− FromDep pkgName (_, m) -> M.insert (P.getModuleName m) pkgName
123− (#) = flip ($)
124−
125−addPackage :: M.Map P.ModuleName PackageName -> P.Module -> InPackage P.Module
126−addPackage depsModules m =
127− case M.lookup (P.getModuleName m) depsModules of
128− Just pkgName -> FromDep pkgName m
129− Nothing -> Local m
src/Language/PureScript/Docs/Render.hsdeleted−133
@@ -1,133 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−
3−-- | Functions for creating `RenderedCode` values from data types in
4−-- Language.PureScript.Docs.Types.
5−--
6−-- These functions are the ones that are used in markdown/html documentation
7−-- generation, but the intention is that you are able to supply your own
8−-- instead if necessary. For example, the Hoogle input file generator
9−-- substitutes some of these
10−
11−module Language.PureScript.Docs.Render where
12−
13−import Data.Maybe (maybeToList)
14−import Data.Monoid ((<>))
15−import qualified Language.PureScript as P
16−
17−import Language.PureScript.Docs.Types
18−import Language.PureScript.Docs.RenderedCode
19−import Language.PureScript.Docs.Utils.MonoidExtras
20−
21−renderDeclaration :: Declaration -> RenderedCode
22−renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions
23−
24−renderDeclarationWithOptions :: RenderTypeOptions -> Declaration -> RenderedCode
25−renderDeclarationWithOptions opts Declaration{..} =
26− mintersperse sp $ case declInfo of
27− ValueDeclaration ty ->
28− [ ident declTitle
29− , syntax "::"
30− , renderType' ty
31− ]
32− DataDeclaration dtype args ->
33− [ keyword (P.showDataDeclType dtype)
34− , renderType' (typeApp declTitle args)
35− ]
36− ExternDataDeclaration kind' ->
37− [ keywordData
38− , renderType' (P.TypeConstructor (notQualified declTitle))
39− , syntax "::"
40− , renderKind kind'
41− ]
42− TypeSynonymDeclaration args ty ->
43− [ keywordType
44− , renderType' (typeApp declTitle args)
45− , syntax "="
46− , renderType' ty
47− ]
48− TypeClassDeclaration args implies ->
49− [ keywordClass ]
50− ++ maybeToList superclasses
51− ++ [renderType' (typeApp declTitle args)]
52− ++ [keywordWhere | any (isTypeClassMember . cdeclInfo) declChildren]
53−
54− where
55− superclasses
56− | null implies = Nothing
57− | otherwise = Just $
58− syntax "("
59− <> mintersperse (syntax "," <> sp) (map renderConstraint implies)
60− <> syntax ")" <> sp <> syntax "<="
61−
62− isTypeClassMember (ChildTypeClassMember _) = True
63− isTypeClassMember _ = False
64− AliasDeclaration for (P.Fixity associativity precedence) ->
65− [ keywordFixity associativity
66− , syntax $ show precedence
67− , ident $ P.showQualified P.runIdent $ dequalifyCurrentModule for
68− , keyword "as"
69− , ident . tail . init $ declTitle
70− ]
71−
72− where
73− renderType' = renderTypeWithOptions opts
74− dequalifyCurrentModule (P.Qualified mn a)
75− | mn == currentModule opts = P.Qualified Nothing a
76− | otherwise = P.Qualified mn a
77−
78−renderChildDeclaration :: ChildDeclaration -> RenderedCode
79−renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions
80−
81−renderChildDeclarationWithOptions :: RenderTypeOptions -> ChildDeclaration -> RenderedCode
82−renderChildDeclarationWithOptions opts ChildDeclaration{..} =
83− mintersperse sp $ case cdeclInfo of
84− ChildInstance constraints ty ->
85− maybeToList (renderConstraints constraints) ++ [ renderType' ty ]
86− ChildDataConstructor args ->
87− [ renderType' typeApp' ]
88− where
89− typeApp' = foldl P.TypeApp ctor' args
90− ctor' = P.TypeConstructor (notQualified cdeclTitle)
91−
92− ChildTypeClassMember ty ->
93− [ ident cdeclTitle
94− , syntax "::"
95− , renderType' ty
96− ]
97− where
98− renderType' = renderTypeWithOptions opts
99−
100−renderConstraint :: P.Constraint -> RenderedCode
101−renderConstraint = renderConstraintWithOptions defaultRenderTypeOptions
102−
103−renderConstraintWithOptions :: RenderTypeOptions -> P.Constraint -> RenderedCode
104−renderConstraintWithOptions opts (pn, tys) =
105− renderTypeWithOptions opts $ foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName pn)) tys
106−
107−renderConstraints :: [P.Constraint] -> Maybe RenderedCode
108−renderConstraints = renderConstraintsWithOptions defaultRenderTypeOptions
109−
110−renderConstraintsWithOptions :: RenderTypeOptions -> [P.Constraint] -> Maybe RenderedCode
111−renderConstraintsWithOptions opts constraints
112− | null constraints = Nothing
113− | otherwise = Just $
114− syntax "("
115− <> renderedConstraints
116− <> syntax ")" <> sp <> syntax "=>"
117− where
118− renderedConstraints =
119− mintersperse (syntax "," <> sp)
120− (map (renderConstraintWithOptions opts) constraints)
121−
122−notQualified :: String -> P.Qualified (P.ProperName a)
123−notQualified = P.Qualified Nothing . P.ProperName
124−
125−typeApp :: String -> [(String, Maybe P.Kind)] -> P.Type
126−typeApp title typeArgs =
127− foldl P.TypeApp
128− (P.TypeConstructor (notQualified title))
129− (map toTypeVar typeArgs)
130−
131−toTypeVar :: (String, Maybe P.Kind) -> P.Type
132−toTypeVar (s, Nothing) = P.TypeVar s
133−toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k
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−188
@@ -1,188 +0,0 @@
1−-- | Functions for producing RenderedCode values from PureScript Type values.
2−
3−module Language.PureScript.Docs.RenderedCode.Render (
4− renderType,
5− renderTypeAtom,
6− renderRow,
7− renderKind,
8− RenderTypeOptions(..),
9− defaultRenderTypeOptions,
10− renderTypeWithOptions
11−) where
12−
13−import Prelude ()
14−import Prelude.Compat
15−
16−import Data.Monoid ((<>))
17−import Data.Maybe (fromMaybe)
18−
19−import Control.Arrow ((<+>))
20−import Control.PatternArrows
21−
22−import Language.PureScript.Crash
23−import Language.PureScript.Names
24−import Language.PureScript.Types
25−import Language.PureScript.Kinds
26−import Language.PureScript.Pretty.Kinds
27−import Language.PureScript.Environment
28−
29−import Language.PureScript.Docs.RenderedCode.Types
30−import Language.PureScript.Docs.Utils.MonoidExtras
31−
32−typeLiterals :: Pattern () Type RenderedCode
33−typeLiterals = mkPattern match
34− where
35− match TypeWildcard =
36− Just (syntax "_")
37− match (TypeVar var) =
38− Just (ident var)
39− match (PrettyPrintObject row) =
40− Just $ mintersperse sp
41− [ syntax "{"
42− , renderRow row
43− , syntax "}"
44− ]
45− match (TypeConstructor (Qualified mn name)) =
46− Just (ctor (runProperName name) (maybeToContainingModule mn))
47− match (ConstrainedType deps ty) =
48− Just $ mintersperse sp
49− [ syntax "(" <> constraints <> syntax ")"
50− , syntax "=>"
51− , renderType ty
52− ]
53− where
54− constraints = mintersperse (syntax "," <> sp) (map renderDep deps)
55− renderDep :: Constraint -> RenderedCode
56− renderDep (pn, tys) =
57− let instApp = foldl TypeApp (TypeConstructor (fmap coerceProperName pn)) tys
58− in renderType instApp
59− match REmpty =
60− Just (syntax "()")
61− match row@RCons{} =
62− Just (syntax "(" <> renderRow row <> syntax ")")
63− match _ =
64− Nothing
65−
66−-- |
67−-- Render code representing a Row
68−--
69−renderRow :: Type -> RenderedCode
70−renderRow = uncurry renderRow' . rowToList
71− where
72− renderRow' h t = renderHead h <> renderTail t
73−
74−renderHead :: [(String, Type)] -> RenderedCode
75−renderHead = mintersperse (syntax "," <> sp) . map renderLabel
76−
77−renderLabel :: (String, Type) -> RenderedCode
78−renderLabel (label, ty) =
79− mintersperse sp
80− [ ident label
81− , syntax "::"
82− , renderType ty
83− ]
84−
85−renderTail :: Type -> RenderedCode
86−renderTail REmpty = mempty
87−renderTail other = sp <> syntax "|" <> sp <> renderType other
88−
89−typeApp :: Pattern () Type (Type, Type)
90−typeApp = mkPattern match
91− where
92− match (TypeApp f x) = Just (f, x)
93− match _ = Nothing
94−
95−appliedFunction :: Pattern () Type (Type, Type)
96−appliedFunction = mkPattern match
97− where
98− match (PrettyPrintFunction arg ret) = Just (arg, ret)
99− match _ = Nothing
100−
101−kinded :: Pattern () Type (Kind, Type)
102−kinded = mkPattern match
103− where
104− match (KindedType t k) = Just (k, t)
105− match _ = Nothing
106−
107−matchTypeAtom :: Pattern () Type RenderedCode
108−matchTypeAtom = typeLiterals <+> fmap parens matchType
109− where
110− parens x = syntax "(" <> x <> syntax ")"
111−
112−matchType :: Pattern () Type RenderedCode
113−matchType = buildPrettyPrinter operators matchTypeAtom
114− where
115− operators :: OperatorTable () Type RenderedCode
116− operators =
117− OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]
118− , [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]
119− , [ Wrap forall_ $ \idents ty -> mconcat [syntax "forall", sp, mintersperse sp (map ident idents), syntax ".", sp, ty] ]
120− , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]
121− ]
122−
123−forall_ :: Pattern () Type ([String], Type)
124−forall_ = mkPattern match
125− where
126− match (PrettyPrintForAll idents ty) = Just (idents, ty)
127− match _ = Nothing
128−
129−insertPlaceholders :: RenderTypeOptions -> Type -> Type
130−insertPlaceholders opts =
131− everywhereOnTypesTopDown convertForAlls . everywhereOnTypes (convert opts)
132−
133−dePrim :: Type -> Type
134−dePrim ty@(TypeConstructor (Qualified _ name))
135− | ty == tyBoolean || ty == tyNumber || ty == tyString =
136− TypeConstructor $ Qualified Nothing name
137−dePrim other = other
138−
139−convert :: RenderTypeOptions -> Type -> Type
140−convert _ (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret
141−convert opts (TypeApp o r) | o == tyObject && prettyPrintObjects opts = PrettyPrintObject r
142−convert _ other = other
143−
144−convertForAlls :: Type -> Type
145−convertForAlls (ForAll i ty _) = go [i] ty
146− where
147− go idents (ForAll ident' ty' _) = go (ident' : idents) ty'
148− go idents other = PrettyPrintForAll idents other
149−convertForAlls other = other
150−
151−preprocessType :: RenderTypeOptions -> Type -> Type
152−preprocessType opts = dePrim . insertPlaceholders opts
153−
154−-- |
155−-- Render code representing a Kind
156−--
157−renderKind :: Kind -> RenderedCode
158−renderKind = kind . prettyPrintKind
159−
160−-- |
161−-- Render code representing a Type, as it should appear inside parentheses
162−--
163−renderTypeAtom :: Type -> RenderedCode
164−renderTypeAtom =
165− fromMaybe (internalError "Incomplete pattern") . pattern matchTypeAtom () . preprocessType defaultRenderTypeOptions
166−
167−
168−-- |
169−-- Render code representing a Type
170−--
171−renderType :: Type -> RenderedCode
172−renderType = renderTypeWithOptions defaultRenderTypeOptions
173−
174−data RenderTypeOptions = RenderTypeOptions
175− { prettyPrintObjects :: Bool
176− , currentModule :: Maybe ModuleName
177− }
178−
179−defaultRenderTypeOptions :: RenderTypeOptions
180−defaultRenderTypeOptions =
181− RenderTypeOptions
182− { prettyPrintObjects = True
183− , currentModule = Nothing
184− }
185−
186−renderTypeWithOptions :: RenderTypeOptions -> Type -> RenderedCode
187−renderTypeWithOptions opts =
188− fromMaybe (internalError "Incomplete pattern") . pattern matchType () . preprocessType opts
src/Language/PureScript/Docs/RenderedCode/Types.hsdeleted−197
@@ -1,197 +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− , keywordFixity
32− ) where
33−
34−import Prelude ()
35−import Prelude.Compat
36−
37−import qualified Data.Aeson as A
38−import Data.Aeson.BetterErrors
39−import Control.Monad.Error.Class (MonadError(..))
40−
41−import qualified Language.PureScript as P
42−
43−-- |
44−-- A single element in a rendered code fragment. The intention is to support
45−-- multiple output formats. For example, plain text, or highlighted HTML.
46−--
47−data RenderedCodeElement
48− = Syntax String
49− | Ident String
50− | Ctor String ContainingModule
51− | Kind String
52− | Keyword String
53− | Space
54− deriving (Show, Eq, Ord)
55−
56−instance A.ToJSON RenderedCodeElement where
57− toJSON (Syntax str) =
58− A.toJSON ["syntax", str]
59− toJSON (Ident str) =
60− A.toJSON ["ident", str]
61− toJSON (Ctor str mn) =
62− A.toJSON ["ctor", A.toJSON str, A.toJSON mn ]
63− toJSON (Kind str) =
64− A.toJSON ["kind", str]
65− toJSON (Keyword str) =
66− A.toJSON ["keyword", str]
67− toJSON Space =
68− A.toJSON ["space" :: String]
69−
70−asRenderedCodeElement :: Parse String RenderedCodeElement
71−asRenderedCodeElement =
72− a Syntax "syntax" <|>
73− a Ident "ident" <|>
74− asCtor <|>
75− a Kind "kind" <|>
76− a Keyword "keyword" <|>
77− asSpace <|>
78− unableToParse
79− where
80− p <|> q = catchError p (const q)
81−
82− a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)
83− asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)
84− asSpace = nth 0 (withString (eq "space")) *> pure Space
85−
86− eq s s' = if s == s' then Right () else Left ""
87−
88− unableToParse = withString (Left . show)
89−
90−-- |
91−-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier
92−-- to read, as the meaning is more explicit.
93−--
94−data ContainingModule
95− = ThisModule
96− | OtherModule P.ModuleName
97− deriving (Show, Eq, Ord)
98−
99−instance A.ToJSON ContainingModule where
100− toJSON mn = A.toJSON (P.runModuleName <$> containingModuleToMaybe mn)
101−
102−asContainingModule :: Parse e ContainingModule
103−asContainingModule =
104− maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asString)
105−
106−-- |
107−-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious
108−-- isomorphism.
109−--
110−maybeToContainingModule :: Maybe P.ModuleName -> ContainingModule
111−maybeToContainingModule Nothing = ThisModule
112−maybeToContainingModule (Just mn) = OtherModule mn
113−
114−-- |
115−-- Convert a 'ContainingModule' to a 'Maybe' 'P.ModuleName', using the obvious
116−-- isomorphism.
117−--
118−containingModuleToMaybe :: ContainingModule -> Maybe P.ModuleName
119−containingModuleToMaybe ThisModule = Nothing
120−containingModuleToMaybe (OtherModule mn) = Just mn
121−
122−-- |
123−-- A version of 'fromMaybe' for 'ContainingModule' values.
124−--
125−fromContainingModule :: P.ModuleName -> ContainingModule -> P.ModuleName
126−fromContainingModule def ThisModule = def
127−fromContainingModule _ (OtherModule mn) = mn
128−
129−-- |
130−-- A type representing a highly simplified version of PureScript code, intended
131−-- for use in output formats like plain text or HTML.
132−--
133−newtype RenderedCode
134− = RC { unRC :: [RenderedCodeElement] }
135− deriving (Show, Eq, Ord, Monoid)
136−
137−instance A.ToJSON RenderedCode where
138− toJSON (RC elems) = A.toJSON elems
139−
140−asRenderedCode :: Parse String RenderedCode
141−asRenderedCode = RC <$> eachInArray asRenderedCodeElement
142−
143−-- |
144−-- This function allows conversion of a 'RenderedCode' value into a value of
145−-- some other type (for example, plain text, or HTML). The first argument
146−-- is a function specifying how each individual 'RenderedCodeElement' should be
147−-- rendered.
148−--
149−outputWith :: Monoid a => (RenderedCodeElement -> a) -> RenderedCode -> a
150−outputWith f = foldMap f . unRC
151−
152−-- |
153−-- A 'RenderedCode' fragment representing a space.
154−--
155−sp :: RenderedCode
156−sp = RC [Space]
157−
158−syntax :: String -> RenderedCode
159−syntax x = RC [Syntax x]
160−
161−ident :: String -> RenderedCode
162−ident x = RC [Ident x]
163−
164−ctor :: String -> ContainingModule -> RenderedCode
165−ctor x m = RC [Ctor x m]
166−
167−kind :: String -> RenderedCode
168−kind x = RC [Kind x]
169−
170−keyword :: String -> RenderedCode
171−keyword kw = RC [Keyword kw]
172−
173−keywordForall :: RenderedCode
174−keywordForall = keyword "forall"
175−
176−keywordData :: RenderedCode
177−keywordData = keyword "data"
178−
179−keywordNewtype :: RenderedCode
180−keywordNewtype = keyword "newtype"
181−
182−keywordType :: RenderedCode
183−keywordType = keyword "type"
184−
185−keywordClass :: RenderedCode
186−keywordClass = keyword "class"
187−
188−keywordInstance :: RenderedCode
189−keywordInstance = keyword "instance"
190−
191−keywordWhere :: RenderedCode
192−keywordWhere = keyword "where"
193−
194−keywordFixity :: P.Associativity -> RenderedCode
195−keywordFixity P.Infixl = keyword "infixl"
196−keywordFixity P.Infixr = keyword "infixr"
197−keywordFixity P.Infix = keyword "infix"
src/Language/PureScript/Docs/Types.hsdeleted−527
@@ -1,527 +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 Prelude ()
13−import Prelude.Compat
14−
15−import Control.Arrow (first, (***))
16−import Control.Monad (when)
17−import Data.Maybe (mapMaybe)
18−import Data.Version
19−import Data.Aeson ((.=))
20−import qualified Data.Aeson as A
21−import Data.Aeson.BetterErrors
22−import Text.ParserCombinators.ReadP (readP_to_S)
23−import Data.Text (Text)
24−import Data.ByteString.Lazy (ByteString)
25−import qualified Data.Text as T
26−
27−import Web.Bower.PackageMeta hiding (Version, displayError)
28−
29−import qualified Language.PureScript as P
30−
31−import Language.PureScript.Docs.RenderedCode as ReExports
32− (RenderedCode, asRenderedCode,
33− ContainingModule(..), asContainingModule,
34− RenderedCodeElement(..), asRenderedCodeElement)
35−
36−--------------------
37−-- Types
38−
39−data Package a = Package
40− { pkgMeta :: PackageMeta
41− , pkgVersion :: Version
42− , pkgVersionTag :: String
43− , pkgModules :: [Module]
44− , pkgBookmarks :: [Bookmark]
45− , pkgResolvedDependencies :: [(PackageName, Version)]
46− , pkgGithub :: (GithubUser, GithubRepo)
47− , pkgUploader :: a
48− , pkgCompilerVersion :: Version
49− -- ^ The version of the PureScript compiler which was used to generate
50− -- this data. We store this in order to reject packages which are too old.
51− }
52− deriving (Show, Eq, Ord)
53−
54−data NotYetKnown = NotYetKnown
55− deriving (Show, Eq, Ord)
56−
57−type UploadedPackage = Package NotYetKnown
58−type VerifiedPackage = Package GithubUser
59−
60−verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage
61−verifyPackage verifiedUser Package{..} =
62− Package pkgMeta
63− pkgVersion
64− pkgVersionTag
65− pkgModules
66− pkgBookmarks
67− pkgResolvedDependencies
68− pkgGithub
69− verifiedUser
70− pkgCompilerVersion
71−
72−packageName :: Package a -> PackageName
73−packageName = bowerName . pkgMeta
74−
75−data Module = Module
76− { modName :: String
77− , modComments :: Maybe String
78− , modDeclarations :: [Declaration]
79− }
80− deriving (Show, Eq, Ord)
81−
82−data Declaration = Declaration
83− { declTitle :: String
84− , declComments :: Maybe String
85− , declSourceSpan :: Maybe P.SourceSpan
86− , declChildren :: [ChildDeclaration]
87− , declFixity :: Maybe P.Fixity -- TODO: remove in 0.9
88− , declInfo :: DeclarationInfo
89− }
90− deriving (Show, Eq, Ord)
91−
92−-- |
93−-- A value of this type contains information that is specific to a particular
94−-- kind of declaration (as opposed to information which exists in all kinds of
95−-- declarations, which goes into the 'Declaration' type directly).
96−--
97−-- Many of the constructors are very similar to their equivalents in the real
98−-- PureScript AST, except that they have their name elided, since this is
99−-- already available via the rdTitle field of 'Declaration'.
100−--
101−data DeclarationInfo
102− -- |
103− -- A value declaration, with its type.
104− --
105− = ValueDeclaration P.Type
106−
107− -- |
108− -- A data/newtype declaration, with the kind of declaration (data or
109− -- newtype) and its type arguments. Constructors are represented as child
110− -- declarations.
111− --
112− | DataDeclaration P.DataDeclType [(String, Maybe P.Kind)]
113−
114− -- |
115− -- A data type foreign import, with its kind.
116− --
117− | ExternDataDeclaration P.Kind
118−
119− -- |
120− -- A type synonym, with its type arguments and its type.
121− --
122− | TypeSynonymDeclaration [(String, Maybe P.Kind)] P.Type
123−
124− -- |
125− -- A type class, with its type arguments and its superclasses. Instances and
126− -- members are represented as child declarations.
127− --
128− | TypeClassDeclaration [(String, Maybe P.Kind)] [P.Constraint]
129−
130− -- |
131− -- An operator alias declaration, with the member the alias is for and the
132− -- operator's fixity.
133− --
134− | AliasDeclaration (P.Qualified P.Ident) P.Fixity
135− deriving (Show, Eq, Ord)
136−
137−declInfoToString :: DeclarationInfo -> String
138−declInfoToString (ValueDeclaration _) = "value"
139−declInfoToString (DataDeclaration _ _) = "data"
140−declInfoToString (ExternDataDeclaration _) = "externData"
141−declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym"
142−declInfoToString (TypeClassDeclaration _ _) = "typeClass"
143−declInfoToString (AliasDeclaration _ _) = "alias"
144−
145−data ChildDeclaration = ChildDeclaration
146− { cdeclTitle :: String
147− , cdeclComments :: Maybe String
148− , cdeclSourceSpan :: Maybe P.SourceSpan
149− , cdeclInfo :: ChildDeclarationInfo
150− }
151− deriving (Show, Eq, Ord)
152−
153−data ChildDeclarationInfo
154− -- |
155− -- A type instance declaration, with its dependencies and its type.
156− --
157− = ChildInstance [P.Constraint] P.Type
158−
159− -- |
160− -- A data constructor, with its type arguments.
161− --
162− | ChildDataConstructor [P.Type]
163−
164− -- |
165− -- A type class member, with its type. Note that the type does not include
166− -- the type class constraint; this may be added manually if desired. For
167− -- example, `pure` from `Applicative` would be `forall a. a -> f a`.
168− --
169− | ChildTypeClassMember P.Type
170− deriving (Show, Eq, Ord)
171−
172−childDeclInfoToString :: ChildDeclarationInfo -> String
173−childDeclInfoToString (ChildInstance _ _) = "instance"
174−childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"
175−childDeclInfoToString (ChildTypeClassMember _) = "typeClassMember"
176−
177−newtype GithubUser
178− = GithubUser { runGithubUser :: String }
179− deriving (Show, Eq, Ord)
180−
181−newtype GithubRepo
182− = GithubRepo { runGithubRepo :: String }
183− deriving (Show, Eq, Ord)
184−
185−data PackageError
186− = CompilerTooOld Version Version
187− -- ^ Minimum allowable version for generating data with the current
188− -- parser, and actual version used.
189− | ErrorInPackageMeta BowerError
190− | InvalidVersion
191− | InvalidDeclarationType String
192− | InvalidChildDeclarationType String
193− | InvalidFixity
194− | InvalidKind String
195− | InvalidDataDeclType String
196− deriving (Show, Eq, Ord)
197−
198−type Bookmark = InPackage (P.ModuleName, String)
199−
200−data InPackage a
201− = Local a
202− | FromDep PackageName a
203− deriving (Show, Eq, Ord)
204−
205−instance Functor InPackage where
206− fmap f (Local x) = Local (f x)
207− fmap f (FromDep pkgName x) = FromDep pkgName (f x)
208−
209−takeLocal :: InPackage a -> Maybe a
210−takeLocal (Local a) = Just a
211−takeLocal _ = Nothing
212−
213−takeLocals :: [InPackage a] -> [a]
214−takeLocals = mapMaybe takeLocal
215−
216−ignorePackage :: InPackage a -> a
217−ignorePackage (Local x) = x
218−ignorePackage (FromDep _ x) = x
219−
220−----------------------
221−-- Parsing
222−
223−parseUploadedPackage :: Version -> ByteString -> Either (ParseError PackageError) UploadedPackage
224−parseUploadedPackage minVersion = parse $ asUploadedPackage minVersion
225−
226−parseVerifiedPackage :: Version -> ByteString -> Either (ParseError PackageError) VerifiedPackage
227−parseVerifiedPackage minVersion = parse $ asVerifiedPackage minVersion
228−
229−asPackage :: Version -> (forall e. Parse e a) -> Parse PackageError (Package a)
230−asPackage minimumVersion uploader = do
231− -- If the compilerVersion key is missing, we can be sure that it was produced
232− -- with 0.7.0.0, since that is the only released version that included the
233− -- psc-publish tool before this key was added.
234− compilerVersion <- keyOrDefault "compilerVersion" (Version [0,7,0,0] []) asVersion
235− when (compilerVersion < minimumVersion)
236− (throwCustomError $ CompilerTooOld minimumVersion compilerVersion)
237−
238− Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta
239− <*> key "version" asVersion
240− <*> key "versionTag" asString
241− <*> key "modules" (eachInArray asModule)
242− <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta
243− <*> key "resolvedDependencies" asResolvedDependencies
244− <*> key "github" asGithub
245− <*> key "uploader" uploader
246− <*> pure compilerVersion
247−
248−asUploadedPackage :: Version -> Parse PackageError UploadedPackage
249−asUploadedPackage minVersion = asPackage minVersion asNotYetKnown
250−
251−asNotYetKnown :: Parse e NotYetKnown
252−asNotYetKnown = NotYetKnown <$ asNull
253−
254−instance A.FromJSON NotYetKnown where
255− parseJSON = toAesonParser' asNotYetKnown
256−
257−asVerifiedPackage :: Version -> Parse PackageError VerifiedPackage
258−asVerifiedPackage minVersion = asPackage minVersion asGithubUser
259−
260−displayPackageError :: PackageError -> Text
261−displayPackageError e = case e of
262− CompilerTooOld minV usedV ->
263− "Expecting data produced by at least version " <> T.pack (showVersion minV)
264− <> " of the compiler, but it appears that " <> T.pack (showVersion usedV)
265− <> " was used."
266− ErrorInPackageMeta err ->
267− "Error in package metadata: " <> showBowerError err
268− InvalidVersion ->
269− "Invalid version"
270− InvalidDeclarationType str ->
271− "Invalid declaration type: \"" <> T.pack str <> "\""
272− InvalidChildDeclarationType str ->
273− "Invalid child declaration type: \"" <> T.pack str <> "\""
274− InvalidFixity ->
275− "Invalid fixity"
276− InvalidKind str ->
277− "Invalid kind: \"" <> T.pack str <> "\""
278− InvalidDataDeclType str ->
279− "Invalid data declaration type: \"" <> T.pack str <> "\""
280− where
281− (<>) = T.append
282−
283−instance A.FromJSON a => A.FromJSON (Package a) where
284− parseJSON = toAesonParser displayPackageError
285− (asPackage (Version [0,0,0,0] []) fromAesonParser)
286−
287−asGithubUser :: Parse e GithubUser
288−asGithubUser = GithubUser <$> asString
289−
290−instance A.FromJSON GithubUser where
291− parseJSON = toAesonParser' asGithubUser
292−
293−asVersion :: Parse PackageError Version
294−asVersion = withString (maybe (Left InvalidVersion) Right . parseVersion')
295−
296−parseVersion' :: String -> Maybe Version
297−parseVersion' str =
298− case filter (null . snd) $ readP_to_S parseVersion str of
299− [(vers, "")] -> Just vers
300− _ -> Nothing
301−
302−asModule :: Parse PackageError Module
303−asModule =
304− Module <$> key "name" asString
305− <*> key "comments" (perhaps asString)
306− <*> key "declarations" (eachInArray asDeclaration)
307−
308−asDeclaration :: Parse PackageError Declaration
309−asDeclaration =
310− Declaration <$> key "title" asString
311− <*> key "comments" (perhaps asString)
312− <*> key "sourceSpan" (perhaps asSourceSpan)
313− <*> key "children" (eachInArray asChildDeclaration)
314− <*> key "fixity" (perhaps asFixity)
315− <*> key "info" asDeclarationInfo
316−
317−asFixity :: Parse PackageError P.Fixity
318−asFixity =
319− P.Fixity <$> key "associativity" asAssociativity
320− <*> key "precedence" asIntegral
321−
322−parseAssociativity :: String -> Maybe P.Associativity
323−parseAssociativity str = case str of
324− "infix" -> Just P.Infix
325− "infixl" -> Just P.Infixl
326− "infixr" -> Just P.Infixr
327− _ -> Nothing
328−
329−asAssociativity :: Parse PackageError P.Associativity
330−asAssociativity = withString (maybe (Left InvalidFixity) Right . parseAssociativity)
331−
332−asDeclarationInfo :: Parse PackageError DeclarationInfo
333−asDeclarationInfo = do
334− ty <- key "declType" asString
335− case ty of
336− "value" ->
337− ValueDeclaration <$> key "type" asType
338− "data" ->
339− DataDeclaration <$> key "dataDeclType" asDataDeclType
340− <*> key "typeArguments" asTypeArguments
341− "externData" ->
342− ExternDataDeclaration <$> key "kind" asKind
343− "typeSynonym" ->
344− TypeSynonymDeclaration <$> key "arguments" asTypeArguments
345− <*> key "type" asType
346− "typeClass" ->
347− TypeClassDeclaration <$> key "arguments" asTypeArguments
348− <*> key "superclasses" (eachInArray asConstraint)
349− "alias" ->
350− AliasDeclaration <$> key "for" asQualifiedIdent
351− <*> key "fixity" asFixity
352− other ->
353− throwCustomError (InvalidDeclarationType other)
354−
355−asTypeArguments :: Parse PackageError [(String, Maybe P.Kind)]
356−asTypeArguments = eachInArray asTypeArgument
357− where
358− asTypeArgument = (,) <$> nth 0 asString <*> nth 1 (perhaps asKind)
359−
360−asKind :: Parse e P.Kind
361−asKind = fromAesonParser
362−
363−asType :: Parse e P.Type
364−asType = fromAesonParser
365−
366−asDataDeclType :: Parse PackageError P.DataDeclType
367−asDataDeclType =
368− withString $ \s -> case s of
369− "data" -> Right P.Data
370− "newtype" -> Right P.Newtype
371− other -> Left (InvalidDataDeclType other)
372−
373−asChildDeclaration :: Parse PackageError ChildDeclaration
374−asChildDeclaration =
375− ChildDeclaration <$> key "title" asString
376− <*> key "comments" (perhaps asString)
377− <*> key "sourceSpan" (perhaps asSourceSpan)
378− <*> key "info" asChildDeclarationInfo
379−
380−asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo
381−asChildDeclarationInfo = do
382− ty <- key "declType" asString
383− case ty of
384− "instance" ->
385− ChildInstance <$> key "dependencies" (eachInArray asConstraint)
386− <*> key "type" asType
387− "dataConstructor" ->
388− ChildDataConstructor <$> key "arguments" (eachInArray asType)
389− "typeClassMember" ->
390− ChildTypeClassMember <$> key "type" asType
391− other ->
392− throwCustomError $ InvalidChildDeclarationType other
393−
394−asSourcePos :: Parse e P.SourcePos
395−asSourcePos = P.SourcePos <$> nth 0 asIntegral
396− <*> nth 1 asIntegral
397−
398−asConstraint :: Parse PackageError P.Constraint
399−asConstraint = (,) <$> nth 0 asQualifiedProperName
400− <*> nth 1 (eachInArray asType)
401−
402−asQualifiedProperName :: Parse e (P.Qualified (P.ProperName a))
403−asQualifiedProperName = fromAesonParser
404−
405−asQualifiedIdent :: Parse e (P.Qualified P.Ident)
406−asQualifiedIdent = fromAesonParser
407−
408−asBookmarks :: Parse BowerError [Bookmark]
409−asBookmarks = eachInArray asBookmark
410−
411−asBookmark :: Parse BowerError Bookmark
412−asBookmark =
413− build <$> key "package" (perhaps (withString parsePackageName))
414− <*> key "item" ((,) <$> nth 0 (P.moduleNameFromString <$> asString)
415− <*> nth 1 asString)
416− where
417− build Nothing = Local
418− build (Just pn) = FromDep pn
419−
420−asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
421−asResolvedDependencies =
422− eachInObjectWithKey (mapLeft ErrorInPackageMeta . parsePackageName . T.unpack) asVersion
423− where
424− mapLeft f (Left x) = Left (f x)
425− mapLeft _ (Right x) = Right x
426−
427−asGithub :: Parse e (GithubUser, GithubRepo)
428−asGithub = (,) <$> nth 0 (GithubUser <$> asString)
429− <*> nth 1 (GithubRepo <$> asString)
430−
431−asSourceSpan :: Parse e P.SourceSpan
432−asSourceSpan = P.SourceSpan <$> key "name" asString
433− <*> key "start" asSourcePos
434− <*> key "end" asSourcePos
435−
436−---------------------
437−-- ToJSON instances
438−
439−instance A.ToJSON a => A.ToJSON (Package a) where
440− toJSON Package{..} =
441− A.object
442− [ "packageMeta" .= pkgMeta
443− , "version" .= showVersion pkgVersion
444− , "versionTag" .= pkgVersionTag
445− , "modules" .= pkgModules
446− , "bookmarks" .= map (fmap (first P.runModuleName)) pkgBookmarks
447− , "resolvedDependencies" .= assocListToJSON (T.pack . runPackageName)
448− (T.pack . showVersion)
449− pkgResolvedDependencies
450− , "github" .= pkgGithub
451− , "uploader" .= pkgUploader
452− , "compilerVersion" .= showVersion P.version
453− ]
454−
455−instance A.ToJSON NotYetKnown where
456− toJSON _ = A.Null
457−
458−instance A.ToJSON Module where
459− toJSON Module{..} =
460− A.object [ "name" .= modName
461− , "comments" .= modComments
462− , "declarations" .= modDeclarations
463− ]
464−
465−instance A.ToJSON Declaration where
466− toJSON Declaration{..} =
467− A.object [ "title" .= declTitle
468− , "comments" .= declComments
469− , "sourceSpan" .= declSourceSpan
470− , "children" .= declChildren
471− , "fixity" .= declFixity
472− , "info" .= declInfo
473− ]
474−
475−instance A.ToJSON ChildDeclaration where
476− toJSON ChildDeclaration{..} =
477− A.object [ "title" .= cdeclTitle
478− , "comments" .= cdeclComments
479− , "sourceSpan" .= cdeclSourceSpan
480− , "info" .= cdeclInfo
481− ]
482−
483−instance A.ToJSON DeclarationInfo where
484− toJSON info = A.object $ "declType" .= declInfoToString info : props
485− where
486− props = case info of
487− ValueDeclaration ty -> ["type" .= ty]
488− DataDeclaration ty args -> ["dataDeclType" .= ty, "typeArguments" .= args]
489− ExternDataDeclaration kind -> ["kind" .= kind]
490− TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]
491− TypeClassDeclaration args super -> ["arguments" .= args, "superclasses" .= super]
492− AliasDeclaration for fixity -> ["for" .= for, "fixity" .= fixity]
493−
494−instance A.ToJSON ChildDeclarationInfo where
495− toJSON info = A.object $ "declType" .= childDeclInfoToString info : props
496− where
497− props = case info of
498− ChildInstance deps ty -> ["dependencies" .= deps, "type" .= ty]
499− ChildDataConstructor args -> ["arguments" .= args]
500− ChildTypeClassMember ty -> ["type" .= ty]
501−
502−instance A.ToJSON GithubUser where
503− toJSON = A.toJSON . runGithubUser
504−
505−instance A.ToJSON GithubRepo where
506− toJSON = A.toJSON . runGithubRepo
507−
508−-- | Given a function for turning association list keys into JSON object keys,
509−-- and a function for turning association list values to JSON string values,
510−-- turns an association list into a JSON object.
511−--
512−-- For example:
513−-- @assocListToJSON T.pack T.pack [("a", "b")]@ will give @{"a": "b"}@.
514−assocListToJSON :: (a -> Text) -> (b -> Text) -> [(a, b)] -> A.Value
515−assocListToJSON f g xs = A.object (map (uncurry (.=) . (f *** g)) xs)
516−
517−instance A.ToJSON a => A.ToJSON (InPackage a) where
518− toJSON x =
519− case x of
520− Local y -> withPackage (Nothing :: Maybe ()) y
521− FromDep pn y -> withPackage (Just pn) y
522− where
523− withPackage :: (A.ToJSON p, A.ToJSON x) => p -> x -> A.Value
524− withPackage p y =
525− A.object [ "package" .= p
526− , "item" .= y
527− ]
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−274
@@ -1,274 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−
5−module Language.PureScript.Environment where
6−
7−import Data.Data
8−import Data.Maybe (fromMaybe)
9−import Data.Aeson.TH
10−import qualified Data.Map as M
11−import qualified Data.Text as T
12−import qualified Data.Aeson as A
13−
14−import Language.PureScript.Crash
15−import Language.PureScript.Kinds
16−import Language.PureScript.Names
17−import Language.PureScript.TypeClassDictionaries
18−import Language.PureScript.Types
19−import qualified Language.PureScript.Constants as C
20−
21−-- |
22−-- The @Environment@ defines all values and types which are currently in scope:
23−--
24−data Environment = Environment {
25− -- |
26− -- Value names currently in scope
27− --
28− names :: M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
29− -- |
30− -- Type names currently in scope
31− --
32− , types :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
33− -- |
34− -- Data constructors currently in scope, along with their associated type
35− -- constructor name, argument types and return type.
36− , dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, Type, [Ident])
37− -- |
38− -- Type synonyms currently in scope
39− --
40− , typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(String, Maybe Kind)], Type)
41− -- |
42− -- Available type class dictionaries
43− --
44− , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))
45− -- |
46− -- Type classes
47− --
48− , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
49− } deriving (Show, Read)
50−
51−-- |
52−-- The initial environment with no values and only the default javascript types defined
53−--
54−initEnvironment :: Environment
55−initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClasses
56−
57−-- |
58−-- The visibility of a name in scope
59−--
60−data NameVisibility
61− -- |
62− -- The name is defined in the current binding group, but is not visible
63− --
64− = Undefined
65− -- |
66− -- The name is defined in the another binding group, or has been made visible by a function binder
67− --
68− | Defined deriving (Show, Read, Eq)
69−
70−-- |
71−-- A flag for whether a name is for an private or public value - only public values will be
72−-- included in a generated externs file.
73−--
74−data NameKind
75− -- |
76− -- A private value introduced as an artifact of code generation (class instances, class member
77− -- accessors, etc.)
78− --
79− = Private
80− -- |
81− -- A public value for a module member or foreing import declaration
82− --
83− | Public
84− -- |
85− -- A name for member introduced by foreign import
86− --
87− | External deriving (Show, Read, Eq, Data, Typeable)
88−
89−-- |
90−-- The kinds of a type
91−--
92−data TypeKind
93− -- |
94− -- Data type
95− --
96− = DataType [(String, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]
97− -- |
98− -- Type synonym
99− --
100− | TypeSynonym
101− -- |
102− -- Foreign data
103− --
104− | ExternData
105− -- |
106− -- A local type variable
107− --
108− | LocalTypeVariable
109− -- |
110− -- A scoped type variable
111− --
112− | ScopedTypeVar
113− deriving (Show, Read, Eq, Data, Typeable)
114−
115−-- |
116−-- The type ('data' or 'newtype') of a data type declaration
117−--
118−data DataDeclType
119− -- |
120− -- A standard data constructor
121− --
122− = Data
123− -- |
124− -- A newtype constructor
125− --
126− | Newtype deriving (Show, Read, Eq, Ord, Data, Typeable)
127−
128−showDataDeclType :: DataDeclType -> String
129−showDataDeclType Data = "data"
130−showDataDeclType Newtype = "newtype"
131−
132−instance A.ToJSON DataDeclType where
133− toJSON = A.toJSON . showDataDeclType
134−
135−instance A.FromJSON DataDeclType where
136− parseJSON = A.withText "DataDeclType" $ \str ->
137− case str of
138− "data" -> return Data
139− "newtype" -> return Newtype
140− other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"
141−
142−-- |
143−-- Construct a ProperName in the Prim module
144−--
145−primName :: String -> Qualified (ProperName a)
146−primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
147−
148−-- |
149−-- Construct a type in the Prim module
150−--
151−primTy :: String -> Type
152−primTy = TypeConstructor . primName
153−
154−-- |
155−-- Type constructor for functions
156−--
157−tyFunction :: Type
158−tyFunction = primTy "Function"
159−
160−-- |
161−-- Type constructor for strings
162−--
163−tyString :: Type
164−tyString = primTy "String"
165−
166−-- |
167−-- Type constructor for strings
168−--
169−tyChar :: Type
170−tyChar = primTy "Char"
171−
172−-- |
173−-- Type constructor for numbers
174−--
175−tyNumber :: Type
176−tyNumber = primTy "Number"
177−
178−-- |
179−-- Type constructor for integers
180−--
181−tyInt :: Type
182−tyInt = primTy "Int"
183−
184−-- |
185−-- Type constructor for booleans
186−--
187−tyBoolean :: Type
188−tyBoolean = primTy "Boolean"
189−
190−-- |
191−-- Type constructor for arrays
192−--
193−tyArray :: Type
194−tyArray = primTy "Array"
195−
196−-- |
197−-- Type constructor for objects
198−--
199−tyObject :: Type
200−tyObject = primTy "Object"
201−
202−-- |
203−-- Check whether a type is an object
204−--
205−isObject :: Type -> Bool
206−isObject = isTypeOrApplied tyObject
207−
208−-- |
209−-- Check whether a type is a function
210−--
211−isFunction :: Type -> Bool
212−isFunction = isTypeOrApplied tyFunction
213−
214−isTypeOrApplied :: Type -> Type -> Bool
215−isTypeOrApplied t1 (TypeApp t2 _) = t1 == t2
216−isTypeOrApplied t1 t2 = t1 == t2
217−
218−-- |
219−-- Smart constructor for function types
220−--
221−function :: Type -> Type -> Type
222−function t1 = TypeApp (TypeApp tyFunction t1)
223−
224−-- |
225−-- The primitive types in the external javascript environment with their
226−-- associated kinds. There is also a pseudo `Partial` type that corresponds to
227−-- the class with the same name.
228−--
229−primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
230−primTypes =
231− M.fromList
232− [ (primName "Function", (FunKind Star (FunKind Star Star), ExternData))
233− , (primName "Array", (FunKind Star Star, ExternData))
234− , (primName "Object", (FunKind (Row Star) Star, ExternData))
235− , (primName "String", (Star, ExternData))
236− , (primName "Char", (Star, ExternData))
237− , (primName "Number", (Star, ExternData))
238− , (primName "Int", (Star, ExternData))
239− , (primName "Boolean", (Star, ExternData))
240− , (primName "Partial", (Star, ExternData))
241− ]
242−
243−-- |
244−-- The primitive class map. This just contains to `Partial` class, used as a
245−-- kind of magic constraint for partial functions.
246−--
247−primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
248−primClasses =
249− M.fromList
250− [ (primName "Partial", ([], [], [])) ]
251−
252−-- |
253−-- Finds information about data constructors from the current environment.
254−--
255−lookupConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> (DataDeclType, ProperName 'TypeName, Type, [Ident])
256−lookupConstructor env ctor =
257− fromMaybe (internalError "Data constructor not found") $ ctor `M.lookup` dataConstructors env
258−
259−-- |
260−-- Checks whether a data constructor is for a newtype.
261−--
262−isNewtypeConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> Bool
263−isNewtypeConstructor e ctor = case lookupConstructor e ctor of
264− (Newtype, _, _, _) -> True
265− (Data, _, _, _) -> False
266−
267−-- |
268−-- Finds information about values from the current environment.
269−--
270−lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)
271−lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env
272−lookupValue _ _ = Nothing
273−
274−$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''TypeKind)
src/Language/PureScript/Errors.hsdeleted−1189

This diff is too big to show here.

src/Language/PureScript/Externs.hsdeleted−206

This diff is too big to show here.

src/Language/PureScript/Kinds.hsdeleted−72

This diff is too big to show here.

src/Language/PureScript/Linter.hsdeleted−113

This diff is too big to show here.

src/Language/PureScript/Linter/Exhaustive.hsdeleted−310

This diff is too big to show here.

src/Language/PureScript/Linter/Imports.hsdeleted−174

This diff is too big to show here.

src/Language/PureScript/Make.hsdeleted−362

This diff is too big to show here.

src/Language/PureScript/ModuleDependencies.hsdeleted−81

This diff is too big to show here.

src/Language/PureScript/Names.hsdeleted−142

This diff is too big to show here.

src/Language/PureScript/Options.hsdeleted−49

This diff is too big to show here.

src/Language/PureScript/Parser.hsdeleted−36

This diff is too big to show here.

src/Language/PureScript/Parser/Common.hsdeleted−122

This diff is too big to show here.

src/Language/PureScript/Parser/Declarations.hsdeleted−568

This diff is too big to show here.

src/Language/PureScript/Parser/JS.hsdeleted−60

This diff is too big to show here.

src/Language/PureScript/Parser/Kinds.hsdeleted−48

This diff is too big to show here.

src/Language/PureScript/Parser/Lexer.hsdeleted−520

This diff is too big to show here.

src/Language/PureScript/Parser/State.hsdeleted−30

This diff is too big to show here.

src/Language/PureScript/Parser/Types.hsdeleted−114

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−80

This diff is too big to show here.

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

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−151

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/Publish.hsdeleted−371

This diff is too big to show here.

src/Language/PureScript/Publish/BoxesHelpers.hsdeleted−38

This diff is too big to show here.

src/Language/PureScript/Publish/ErrorsWarnings.hsdeleted−384

This diff is too big to show here.

src/Language/PureScript/Publish/Utils.hsdeleted−38

This diff is too big to show here.

src/Language/PureScript/Renamer.hsdeleted−197

This diff is too big to show here.

src/Language/PureScript/Sugar.hsdeleted−78

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/Sugar/Names/Env.hsdeleted−220

This diff is too big to show here.

src/Language/PureScript/Sugar/Names/Exports.hsdeleted−276

This diff is too big to show here.

src/Language/PureScript/Sugar/Names/Imports.hsdeleted−310

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/Sugar/TypeClasses/Deriving.hsdeleted−246

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/Traversals.hsdeleted−42

This diff is too big to show here.

src/Language/PureScript/TypeChecker.hsdeleted−441

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/TypeClassDictionaries.hsdeleted−48

This diff is too big to show here.

src/Language/PureScript/Types.hsdeleted−302

This diff is too big to show here.

src/System/IO/UTF8.hsdeleted−25

This diff is too big to show here.

src/Tests.hsnew file+141

This diff is too big to show here.

stack-lts-2.yamldeleted−9

This diff is too big to show here.

stack-lts-3.yamldeleted−5

This diff is too big to show here.

stack-nightly.yamldeleted−5

This diff is too big to show here.

stack.nixnew file+23

This diff is too big to show here.

stack.yamlmode 120000 → 100644+24−1

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−226

This diff is too big to show here.

tests/TestPscPublish.hsdeleted−65

This diff is too big to show here.

tests/common/TestsSetup.hsdeleted−45

This diff is too big to show here.

tests/support/.gitignoredeleted−2

This diff is too big to show here.

tests/support/bower.jsondeleted−11

This diff is too big to show here.

tests/support/package.jsondeleted−7

This diff is too big to show here.

tests/support/preludedeleted−1

This diff is too big to show here.

tests/support/setup-win.cmddeleted−3

This diff is too big to show here.

tests/support/setup.jsdeleted−22

This diff is too big to show here.

travis/after.shdeleted−25

This diff is too big to show here.

travis/configure.shdeleted−17

This diff is too big to show here.

travis/test-install.shdeleted−18

This diff is too big to show here.