git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
swap
355eb9b1535 ahead, 0 behind
437 files changed+2707−30917
since splitsnapshots
unifiedsplit
.gitignore+6−1 .travis.yml−80 CONTRIBUTING.md−44 CONTRIBUTORS.md−61 ChangeLog.md+3 INSTALL.md−57 LICENSE+24−1962 README-go.md+48 README.md+32−19 Setup.hs−4 app/Main.hs+250 bundle/.gitignore−3 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−23 default.nix+23 examples/.gitignore−1 examples/failing/1071.purs−8 examples/failing/1310.purs−18 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/CaseDoesNotMatchAllConstructorArgs.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/EmptyDo.purs−6 examples/failing/ExtraRecordField.purs−10 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/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−11 examples/failing/MultipleErrors.purs−13 examples/failing/MultipleErrors2.purs−9 examples/failing/MutRec.purs−8 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/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/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/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/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/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−12 examples/passing/NamedPatterns.purs−9 examples/passing/NegativeBinder.purs−9 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/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/OperatorAssociativity.purs−25 examples/passing/OperatorInlining.purs−47 examples/passing/OperatorSections.purs−11 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/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/ShadowedRename.purs−14 examples/passing/ShadowedTCO.purs−18 examples/passing/ShadowedTCOLet.purs−9 examples/passing/SignedNumericLiterals.purs−17 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/TypedBinders.purs−62 examples/passing/TypedWhere.purs−17 examples/passing/UTF8Sourcefile.purs−10 examples/passing/UnderscoreIdent.purs−11 examples/passing/Unit.purs−6 examples/passing/UnknownInTypeClassLookup.purs−14 examples/passing/Where.purs−49 examples/passing/iota.purs−9 examples/passing/s.purs−7 hierarchy/Main.hs−114 license-generator/generate−47 license-generator/header.txt−23 license-generator/tmp/.gitkeep logo.png package.yaml+86 pcc/Main.hs−174 pcc/Make.hs−193 pcc/Makefile.example−16 pcc/TestMain.hs−140 pcc/include/hash.hh−42 pcc/include/map_key.hh−57 pcc/include/purescript.cc−536 pcc/include/purescript.hh−403 psc-bundle/Main.hs−138 psc-bundle/README.md−18 psc-docs/Ctags.hs−13 psc-docs/Etags.hs−15 psc-docs/Main.hs−251 psc-docs/Tags.hs−18 psc-publish/Main.hs−38 psc-publish/tests/Test.hs−79 psc/Main.hs−192 psci/Completion.hs−233 psci/Directive.hs−115 psci/IO.hs−21 psci/PSCi.hs−604 psci/Parser.hs−143 psci/Types.hs−181 psci/main/Main.hs−6 psci/tests/Main.hs−163 psci/tests/data/Sample.purs psgo.cabal+145 purescript.cabal−312 src/CodeGen/IL.hs+321 src/CodeGen/IL/Common.hs+196 src/CodeGen/IL/Optimizer.hs+81 src/CodeGen/IL/Optimizer/Common.hs+18 src/CodeGen/IL/Optimizer/Inliner.hs+435 src/CodeGen/IL/Optimizer/MagicDo.hs+146 src/CodeGen/IL/Optimizer/TCO.hs+141 src/CodeGen/IL/Printer.hs+527 src/Control/Monad/Supply.hs−46 src/Control/Monad/Supply/Class.hs−36 src/Control/Monad/Unify.hs−160 src/Language/PureScript.hs−49 src/Language/PureScript/AST.hs−24 src/Language/PureScript/AST/Binders.hs−92 src/Language/PureScript/AST/Declarations.hs−438 src/Language/PureScript/AST/Exported.hs−136 src/Language/PureScript/AST/Operators.hs−60 src/Language/PureScript/AST/SourcePos.hs−98 src/Language/PureScript/AST/Traversals.hs−415 src/Language/PureScript/Bundle.hs−552 src/Language/PureScript/CodeGen.hs−20 src/Language/PureScript/CodeGen/Cpp.hs−528 src/Language/PureScript/CodeGen/Cpp/AST.hs−352 src/Language/PureScript/CodeGen/Cpp/Common.hs−205 src/Language/PureScript/CodeGen/Cpp/File.hs−158 src/Language/PureScript/CodeGen/Cpp/Optimizer.hs−92 src/Language/PureScript/CodeGen/Cpp/Optimizer/Blocks.hs−42 src/Language/PureScript/CodeGen/Cpp/Optimizer/Common.hs−75 src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs−319 src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs−117 src/Language/PureScript/CodeGen/Cpp/Optimizer/TCO.hs−149 src/Language/PureScript/CodeGen/Cpp/Optimizer/Unused.hs−43 src/Language/PureScript/CodeGen/Cpp/Types.hs−122 src/Language/PureScript/CodeGen/JS.hs−363 src/Language/PureScript/CodeGen/JS/AST.hs−349 src/Language/PureScript/CodeGen/JS/Common.hs−181 src/Language/PureScript/CodeGen/JS/Optimizer.hs−92 src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs−42 src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs−77 src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs−318 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−48 src/Language/PureScript/CoreFn/Desugar.hs−265 src/Language/PureScript/CoreFn/Expr.hs−134 src/Language/PureScript/CoreFn/Literals.hs−50 src/Language/PureScript/CoreFn/Meta.hs−55 src/Language/PureScript/CoreFn/Module.hs−31 src/Language/PureScript/CoreFn/Traversals.hs−85 src/Language/PureScript/Docs.hs−14 src/Language/PureScript/Docs/AsMarkdown.hs−124 src/Language/PureScript/Docs/Convert.hs−226 src/Language/PureScript/Docs/ParseAndDesugar.hs−146 src/Language/PureScript/Docs/Render.hs−128 src/Language/PureScript/Docs/RenderedCode.hs−11 src/Language/PureScript/Docs/RenderedCode/Render.hs−184 src/Language/PureScript/Docs/RenderedCode/Types.hs−194 src/Language/PureScript/Docs/Types.hs−513 src/Language/PureScript/Docs/Utils/MonoidExtras.hs−9 src/Language/PureScript/Environment.hs−272 src/Language/PureScript/Errors.hs−967 src/Language/PureScript/Externs.hs−216 src/Language/PureScript/Kinds.hs−75 src/Language/PureScript/Linter.hs−119 src/Language/PureScript/Linter/Exhaustive.hs−310 src/Language/PureScript/Make.hs−387 src/Language/PureScript/ModuleDependencies.hs−79 src/Language/PureScript/Names.hs−120 src/Language/PureScript/Options.hs−49 src/Language/PureScript/Parser.hs−36 src/Language/PureScript/Parser/Common.hs−139 src/Language/PureScript/Parser/Declarations.hs−568 src/Language/PureScript/Parser/JS.hs−62 src/Language/PureScript/Parser/Kinds.hs−49 src/Language/PureScript/Parser/Lexer.hs−520 src/Language/PureScript/Parser/State.hs−30 src/Language/PureScript/Parser/Types.hs−137 src/Language/PureScript/Pretty.hs−32 src/Language/PureScript/Pretty/Common.hs−80 src/Language/PureScript/Pretty/Cpp.hs−427 src/Language/PureScript/Pretty/JS.hs−306 src/Language/PureScript/Pretty/Kinds.hs−58 src/Language/PureScript/Pretty/Types.hs−150 src/Language/PureScript/Pretty/Values.hs−168 src/Language/PureScript/Publish.hs−366 src/Language/PureScript/Publish/BoxesHelpers.hs−38 src/Language/PureScript/Publish/ErrorsWarnings.hs−395 src/Language/PureScript/Publish/Utils.hs−38 src/Language/PureScript/Renamer.hs−200 src/Language/PureScript/Sugar.hs−79 src/Language/PureScript/Sugar/BindingGroups.hs−208 src/Language/PureScript/Sugar/CaseDeclarations.hs−186 src/Language/PureScript/Sugar/DoNotation.hs−77 src/Language/PureScript/Sugar/Names.hs−283 src/Language/PureScript/Sugar/Names/Env.hs−191 src/Language/PureScript/Sugar/Names/Exports.hs−235 src/Language/PureScript/Sugar/Names/Imports.hs−210 src/Language/PureScript/Sugar/ObjectWildcards.hs−68 src/Language/PureScript/Sugar/Operators.hs−177 src/Language/PureScript/Sugar/TypeClasses.hs−309 src/Language/PureScript/Sugar/TypeClasses/Deriving.hs−232 src/Language/PureScript/Sugar/TypeDeclarations.hs−76 src/Language/PureScript/Traversals.hs−45 src/Language/PureScript/TypeChecker.hs−365 src/Language/PureScript/TypeChecker/Entailment.hs−178 src/Language/PureScript/TypeChecker/Kinds.hs−223 src/Language/PureScript/TypeChecker/Monad.hs−278 src/Language/PureScript/TypeChecker/Rows.hs−66 src/Language/PureScript/TypeChecker/Skolems.hs−118 src/Language/PureScript/TypeChecker/Subsumption.hs−88 src/Language/PureScript/TypeChecker/Synonyms.hs−64 src/Language/PureScript/TypeChecker/Types.hs−672 src/Language/PureScript/TypeChecker/Unify.hs−194 src/Language/PureScript/TypeClassDictionaries.hs−62 src/Language/PureScript/Types.hs−315 src/System/IO/UTF8.hs−9 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−221 tests/common/TestsSetup.hs−48 tests/support/.gitignore−2 tests/support/bower.json−11 tests/support/package.json−7 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
.travis.ymldeleted−80
@@ -1,80 +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−before_install:
28− - unset CC
29− - export PATH="/opt/ghc/$GHCVER/bin:$PATH"
30− - export PATH="/opt/cabal/1.22/bin:$PATH"
31− - export PATH="$HOME/.cabal/bin:$PATH"
32− - export PATH="/opt/happy/1.19.5/bin:/$PATH"
33− - export PATH="/opt/alex/3.1.4/bin:/$PATH"
34−install:
35− - cabal --version
36− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
37− - travis_retry cabal update
38− # Run sequentially
39− # Travis container infrastructure seems to expose all host CPUs (16?), thus
40− # cabal and ghc tries to use them all. Which is bad idea on a shared box.
41− # See also: https://ghc.haskell.org/trac/ghc/ticket/9221
42− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
43− # Cache sandboxes in ~/cabal-sandboxes
44− # Move right sandbox to .cabal-sandbox if exists
45− - if [ -d ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none} ]; then
46− mv ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none} .cabal-sandbox;
47− fi
48− - mkdir -p .cabal-sandbox
49− - cabal sandbox init --sandbox .cabal-sandbox
50− # Download stackage cabal.config, not sure whether filtering is necessary
51− - if [ -n "$STACKAGE" ]; then curl http://www.stackage.org/$STACKAGE/cabal.config | grep -v purescript > cabal.config; fi
52− - cabal install --only-dependencies --enable-tests
53− - cabal install hpc-coveralls
54− # Snapshot state of the sandbox now, so we don't need to make new one for test install
55− - rm -rf ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
56− - cp -r .cabal-sandbox ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
57−script:
58− - ./travis/configure.sh
59− - cabal build --ghc-options="-Werror"
60− - cabal test
61− - ./travis/test-install.sh
62−after_script:
63− - ./travis/after.sh
64−notifications:
65− email: true
66−before_deploy: "./bundle/build.sh linux64"
67−deploy:
68− provider: releases
69− api_key: $RELEASE_KEY
70− file:
71− - bundle/linux64.tar.gz
72− - bundle/linux64.sha
73− skip_cleanup: true
74− on:
75− all_branches: true
76− tags: true
77− condition: "$DEPLOY = yes"
78−cache:
79− directories:
80− - ~/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: `./license/generate > 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−61
@@ -1,61 +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−- [@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).
30−- [@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).
31−- [@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.
32−- [@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).
33−- [@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).
34−- [@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).
35−- [@nagisa](https://github.com/nagisa) I hereby release my [only contribution](https://github.com/purescript/purescript/commit/80287a5d0de619862d3b4cda9c1ee276d18fdcd8) into public domain.
36−- [@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).
37−- [@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).
38−- [@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).
39−- [@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.
40−- [@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).
41−- [@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).
42−- [@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).
43−- [@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).
44−- [@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).
45−- [@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).
46−- [@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.
47−- [@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).
48−- [@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).
49−- [@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.
50−- [@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).
51−- [@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).
52−- [@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).
53−- [@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).
54−- [@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.
55−- [@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).
56−- [@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).
57−<http://opensource.org/licenses/MIT>.
58−
59−### Companies
60−
61−- [@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 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−1962
@@ -1,1968 +1,30 @@
1−The MIT License (MIT)
1+Copyright Andy Arvanitis (c) 2018
22
3−Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other
4−contributors
3+All rights reserved.
54
6−Permission is hereby granted, free of charge, to any person obtaining a copy of
7−this software and associated documentation files (the "Software"), to deal in
8−the Software without restriction, including without limitation the rights to
9−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
10−the Software, and to permit persons to whom the Software is furnished to do so,
11−subject to the following conditions:
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
127
13−The above copyright notice and this permission notice shall be included in all
14−copies or substantial portions of the Software.
15−
16−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
18−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
19−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
20−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
21−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22−
23−PureScript uses the following Haskell library packages. Their license files follow.
24−
25− Glob
26− HUnit
27− aeson
28− aeson-better-errors
29− ansi-terminal
30− ansi-wl-pprint
31− array
32− attoparsec
33− base
34− binary
35− blaze-builder
36− bower-json
37− boxes
38− bytestring
39− containers
40− deepseq
41− directory
42− dlist
43− filepath
44− ghc-prim
45− hashable
46− haskeline
47− integer-gmp
48− language-javascript
49− lifted-base
50− monad-control
51− mtl
52− nats
53− optparse-applicative
54− parsec
55− pattern-arrows
56− pretty
57− primitive
58− process
59− rts
60− safe
61− scientific
62− semigroups
63− split
64− stm
65− syb
66− template-haskell
67− terminfo
68− text
69− time
70− transformers
71− transformers-base
72− transformers-compat
73− unix
74− unordered-containers
75− utf8-string
76− vector
77− void
78−
79−Glob LICENSE file:
80−
81− The code in Glob is released under the license below. Copyrights to parts of
82− the code are held by whoever wrote the code in question: see CREDITS.txt for a
83− list of authors.
84−
85− Copyright (c) 2008-2012 <authors>
86− All rights reserved.
87−
88− Redistribution and use in source and binary forms, with or without
89− modification, are permitted provided that the following conditions are met:
90− * Redistributions of source code must retain the above copyright
91− notice, this list of conditions and the following disclaimer.
92− * Redistributions in binary form must reproduce the above copyright
93− notice, this list of conditions and the following disclaimer in the
94− documentation and/or other materials provided with the distribution.
95− * Neither the name of the project nor the names of its contributors may be
96− used to endorse or promote products derived from this software without
97− specific prior written permission.
98−
99− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED
100− WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
101− MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
102− EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
103− INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
104− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
105− PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
106− LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
107− OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
108− ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
109−
110−HUnit LICENSE file:
111−
112− HUnit is Copyright (c) Dean Herington, 2002, all rights reserved,
113− and is distributed as free software under the following license.
114−
115− Redistribution and use in source and binary forms, with or without
116− modification, are permitted provided that the following conditions
117− are met:
118−
119− - Redistributions of source code must retain the above copyright
120− notice, this list of conditions, and the following disclaimer.
121−
122− - Redistributions in binary form must reproduce the above copyright
123− notice, this list of conditions, and the following disclaimer in the
124− documentation and/or other materials provided with the distribution.
125−
126− - The names of the copyright holders may not be used to endorse or
127− promote products derived from this software without specific prior
128− written permission.
129−
130− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
131− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
132− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
133− PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
134− LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
135− CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
136− SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
137− BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
138− WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
139− OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
140− IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
141−
142−aeson LICENSE file:
143−
144− Copyright (c) 2011, MailRank, Inc.
145−
146− All rights reserved.
147−
148− Redistribution and use in source and binary forms, with or without
149− modification, are permitted provided that the following conditions
150− are met:
151−
152− 1. Redistributions of source code must retain the above copyright
153− notice, this list of conditions and the following disclaimer.
154−
155− 2. Redistributions in binary form must reproduce the above copyright
156− notice, this list of conditions and the following disclaimer in the
157− documentation and/or other materials provided with the distribution.
158−
159− 3. Neither the name of the author nor the names of his contributors
160− may be used to endorse or promote products derived from this software
161− without specific prior written permission.
162−
163− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
164− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
165− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
166− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
167− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
168− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
169− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
170− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
171− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
172− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
173− POSSIBILITY OF SUCH DAMAGE.
174−
175−aeson-better-errors LICENSE file:
176−
177− Copyright (c) 2015 Harry Garrood
178−
179− Permission is hereby granted, free of charge, to any person obtaining
180− a copy of this software and associated documentation files (the
181− "Software"), to deal in the Software without restriction, including
182− without limitation the rights to use, copy, modify, merge, publish,
183− distribute, sublicense, and/or sell copies of the Software, and to
184− permit persons to whom the Software is furnished to do so, subject to
185− the following conditions:
186−
187− The above copyright notice and this permission notice shall be included
188− in all copies or substantial portions of the Software.
189−
190− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
191− EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
192− MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
193− IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
194− CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
195− TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
196− SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
197−
198−ansi-terminal LICENSE file:
199−
200− Copyright (c) 2008, Maximilian Bolingbroke
201− All rights reserved.
202−
203− Redistribution and use in source and binary forms, with or without modification, are permitted
204− provided that the following conditions are met:
205−
206− * Redistributions of source code must retain the above copyright notice, this list of
207− conditions and the following disclaimer.
208− * Redistributions in binary form must reproduce the above copyright notice, this list of
209− conditions and the following disclaimer in the documentation and/or other materials
210− provided with the distribution.
211− * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to
212− endorse or promote products derived from this software without specific prior written permission.
213−
214− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
215− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
216− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
217− CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
218− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
219− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
220− IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
221− OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
222−
223−ansi-wl-pprint LICENSE file:
224−
225− Copyright 2008, Daan Leijen and Max Bolingbroke. All rights reserved.
226−
227− Redistribution and use in source and binary forms, with or without
228− modification, are permitted provided that the following conditions are
229− met:
230−
2318 * Redistributions of source code must retain the above copyright
2329 notice, this list of conditions and the following disclaimer.
233−
234− * Redistributions in binary form must reproduce the above copyright
235− notice, this list of conditions and the following disclaimer in
236− the documentation and/or other materials provided with the
237− distribution.
238−
239− This software is provided by the copyright holders "as is" and any
240− express or implied warranties, including, but not limited to, the
241− implied warranties of merchantability and fitness for a particular
242− purpose are disclaimed. In no event shall the copyright holders be
243− liable for any direct, indirect, incidental, special, exemplary, or
244− consequential damages (including, but not limited to, procurement of
245− substitute goods or services; loss of use, data, or profits; or
246− business interruption) however caused and on any theory of liability,
247− whether in contract, strict liability, or tort (including negligence
248− or otherwise) arising in any way out of the use of this software, even
249− if advised of the possibility of such damage.
250−
251−array LICENSE file:
252−
253− This library (libraries/base) is derived from code from several
254− sources:
255−
256− * Code from the GHC project which is largely (c) The University of
257− Glasgow, and distributable under a BSD-style license (see below),
258−
259− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
260− and freely redistributable (but see the full license for
261− restrictions).
262−
263− * Code from the Haskell Foreign Function Interface specification,
264− which is (c) Manuel M. T. Chakravarty and freely redistributable
265− (but see the full license for restrictions).
266−
267− The full text of these licenses is reproduced below. All of the
268− licenses are BSD-style or compatible.
269−
270− -----------------------------------------------------------------------------
271−
272− The Glasgow Haskell Compiler License
273−
274− Copyright 2004, The University Court of the University of Glasgow.
275− All rights reserved.
276−
277− Redistribution and use in source and binary forms, with or without
278− modification, are permitted provided that the following conditions are met:
279−
280− - Redistributions of source code must retain the above copyright notice,
281− this list of conditions and the following disclaimer.
282−
283− - Redistributions in binary form must reproduce the above copyright notice,
284− this list of conditions and the following disclaimer in the documentation
285− and/or other materials provided with the distribution.
286−
287− - Neither name of the University nor the names of its contributors may be
288− used to endorse or promote products derived from this software without
289− specific prior written permission.
290−
291− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
292− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
293− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
294− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
295− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
296− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
297− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
298− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
299− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
300− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
301− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
302− DAMAGE.
303−
304− -----------------------------------------------------------------------------
305−
306− Code derived from the document "Report on the Programming Language
307− Haskell 98", is distributed under the following license:
308−
309− Copyright (c) 2002 Simon Peyton Jones
310−
311− The authors intend this Report to belong to the entire Haskell
312− community, and so we grant permission to copy and distribute it for
313− any purpose, provided that it is reproduced in its entirety,
314− including this Notice. Modified versions of this Report may also be
315− copied and distributed for any purpose, provided that the modified
316− version is clearly presented as such, and that it does not claim to
317− be a definition of the Haskell 98 Language.
318−
319− -----------------------------------------------------------------------------
320−
321− Code derived from the document "The Haskell 98 Foreign Function
322− Interface, An Addendum to the Haskell 98 Report" is distributed under
323− the following license:
324−
325− Copyright (c) 2002 Manuel M. T. Chakravarty
326−
327− The authors intend this Report to belong to the entire Haskell
328− community, and so we grant permission to copy and distribute it for
329− any purpose, provided that it is reproduced in its entirety,
330− including this Notice. Modified versions of this Report may also be
331− copied and distributed for any purpose, provided that the modified
332− version is clearly presented as such, and that it does not claim to
333− be a definition of the Haskell 98 Foreign Function Interface.
334−
335− -----------------------------------------------------------------------------
336−
337−attoparsec LICENSE file:
338−
339− Copyright (c) Lennart Kolmodin
340−
341− All rights reserved.
342−
343− Redistribution and use in source and binary forms, with or without
344− modification, are permitted provided that the following conditions
345− are met:
346−
347− 1. Redistributions of source code must retain the above copyright
348− notice, this list of conditions and the following disclaimer.
349−
350− 2. Redistributions in binary form must reproduce the above copyright
351− notice, this list of conditions and the following disclaimer in the
352− documentation and/or other materials provided with the distribution.
353−
354− 3. Neither the name of the author nor the names of his contributors
355− may be used to endorse or promote products derived from this software
356− without specific prior written permission.
357−
358− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
359− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
360− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
361− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
362− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
363− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
364− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
365− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
366− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
367− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
368− POSSIBILITY OF SUCH DAMAGE.
369−
370−base LICENSE file:
371−
372− This library (libraries/base) is derived from code from several
373− sources:
374−
375− * Code from the GHC project which is largely (c) The University of
376− Glasgow, and distributable under a BSD-style license (see below),
377−
378− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
379− and freely redistributable (but see the full license for
380− restrictions).
381−
382− * Code from the Haskell Foreign Function Interface specification,
383− which is (c) Manuel M. T. Chakravarty and freely redistributable
384− (but see the full license for restrictions).
385−
386− The full text of these licenses is reproduced below. All of the
387− licenses are BSD-style or compatible.
388−
389− -----------------------------------------------------------------------------
390−
391− The Glasgow Haskell Compiler License
392−
393− Copyright 2004, The University Court of the University of Glasgow.
394− All rights reserved.
395−
396− Redistribution and use in source and binary forms, with or without
397− modification, are permitted provided that the following conditions are met:
398−
399− - Redistributions of source code must retain the above copyright notice,
400− this list of conditions and the following disclaimer.
401−
402− - Redistributions in binary form must reproduce the above copyright notice,
403− this list of conditions and the following disclaimer in the documentation
404− and/or other materials provided with the distribution.
405−
406− - Neither name of the University nor the names of its contributors may be
407− used to endorse or promote products derived from this software without
408− specific prior written permission.
409−
410− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
411− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
412− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
413− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
414− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
415− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
416− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
417− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
418− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
419− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
420− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
421− DAMAGE.
422−
423− -----------------------------------------------------------------------------
424−
425− Code derived from the document "Report on the Programming Language
426− Haskell 98", is distributed under the following license:
427−
428− Copyright (c) 2002 Simon Peyton Jones
429−
430− The authors intend this Report to belong to the entire Haskell
431− community, and so we grant permission to copy and distribute it for
432− any purpose, provided that it is reproduced in its entirety,
433− including this Notice. Modified versions of this Report may also be
434− copied and distributed for any purpose, provided that the modified
435− version is clearly presented as such, and that it does not claim to
436− be a definition of the Haskell 98 Language.
437−
438− -----------------------------------------------------------------------------
439−
440− Code derived from the document "The Haskell 98 Foreign Function
441− Interface, An Addendum to the Haskell 98 Report" is distributed under
442− the following license:
443−
444− Copyright (c) 2002 Manuel M. T. Chakravarty
445−
446− The authors intend this Report to belong to the entire Haskell
447− community, and so we grant permission to copy and distribute it for
448− any purpose, provided that it is reproduced in its entirety,
449− including this Notice. Modified versions of this Report may also be
450− copied and distributed for any purpose, provided that the modified
451− version is clearly presented as such, and that it does not claim to
452− be a definition of the Haskell 98 Foreign Function Interface.
453−
454− -----------------------------------------------------------------------------
455−
456−binary LICENSE file:
457−
458− Copyright (c) Lennart Kolmodin
459−
460− All rights reserved.
461−
462− Redistribution and use in source and binary forms, with or without
463− modification, are permitted provided that the following conditions
464− are met:
465−
466− 1. Redistributions of source code must retain the above copyright
467− notice, this list of conditions and the following disclaimer.
468−
469− 2. Redistributions in binary form must reproduce the above copyright
470− notice, this list of conditions and the following disclaimer in the
471− documentation and/or other materials provided with the distribution.
472−
473− 3. Neither the name of the author nor the names of his contributors
474− may be used to endorse or promote products derived from this software
475− without specific prior written permission.
476−
477− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
478− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
479− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
480− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
481− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
482− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
483− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
484− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
485− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
486− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
487− POSSIBILITY OF SUCH DAMAGE.
488−
489−blaze-builder LICENSE file:
490−
491− Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011
492−
493− All rights reserved.
494−
495− Redistribution and use in source and binary forms, with or without
496− modification, are permitted provided that the following conditions are met:
497−
498− * Redistributions of source code must retain the above copyright
499− notice, this list of conditions and the following disclaimer.
500−
501− * Redistributions in binary form must reproduce the above
502− copyright notice, this list of conditions and the following
503− disclaimer in the documentation and/or other materials provided
504− with the distribution.
505−
506− * Neither the name of Jasper Van der Jeugt nor the names of other
507− contributors may be used to endorse or promote products derived
508− from this software without specific prior written permission.
509−
510− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
511− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
512− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
513− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
514− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
515− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
516− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
517− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
518− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
519− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
520− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
521−
522−bower-json LICENSE file:
523−
524− Copyright (c) 2015 Harry Garrood
525−
526− Permission is hereby granted, free of charge, to any person obtaining
527− a copy of this software and associated documentation files (the
528− "Software"), to deal in the Software without restriction, including
529− without limitation the rights to use, copy, modify, merge, publish,
530− distribute, sublicense, and/or sell copies of the Software, and to
531− permit persons to whom the Software is furnished to do so, subject to
532− the following conditions:
533−
534− The above copyright notice and this permission notice shall be included
535− in all copies or substantial portions of the Software.
536−
537− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
538− EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
539− MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
540− IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
541− CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
542− TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
543− SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
544−
545−boxes LICENSE file:
546−
547− Copyright (c) Brent Yorgey 2008
548−
549− Redistribution and use in source and binary forms, with or without
550− modification, are permitted provided that the following conditions
551− are met:
552− 1. Redistributions of source code must retain the above copyright
553− notice, this list of conditions and the following disclaimer.
554− 2. Redistributions in binary form must reproduce the above copyright
555− notice, this list of conditions and the following disclaimer in the
556− documentation and/or other materials provided with the distribution.
557− 3. Neither the name of the author nor the names of other contributors
558− may be used to endorse or promote products derived from this software
559− without specific prior written permission.
560−
561− All other rights are reserved.
562−
563− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
564− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
565− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
566− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
567− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
568− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
569− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
570− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
571− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
572− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
573− SUCH DAMAGE.
574−
575−bytestring LICENSE file:
576−
577− Copyright (c) Don Stewart 2005-2009
578− (c) Duncan Coutts 2006-2015
579− (c) David Roundy 2003-2005
580− (c) Simon Meier 2010-2011
581−
582− All rights reserved.
583−
584− Redistribution and use in source and binary forms, with or without
585− modification, are permitted provided that the following conditions
586− are met:
587− 1. Redistributions of source code must retain the above copyright
588− notice, this list of conditions and the following disclaimer.
589− 2. Redistributions in binary form must reproduce the above copyright
590− notice, this list of conditions and the following disclaimer in the
591− documentation and/or other materials provided with the distribution.
592− 3. Neither the name of the author nor the names of his contributors
593− may be used to endorse or promote products derived from this software
594− without specific prior written permission.
595−
596− THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
597− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
598− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
599− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
600− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
601− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
602− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
603− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
604− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
605− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
606− SUCH DAMAGE.
607−
608−containers LICENSE file:
609−
610− The Glasgow Haskell Compiler License
611−
612− Copyright 2004, The University Court of the University of Glasgow.
613− All rights reserved.
614−
615− Redistribution and use in source and binary forms, with or without
616− modification, are permitted provided that the following conditions are met:
617−
618− - Redistributions of source code must retain the above copyright notice,
619− this list of conditions and the following disclaimer.
620−
621− - Redistributions in binary form must reproduce the above copyright notice,
622− this list of conditions and the following disclaimer in the documentation
623− and/or other materials provided with the distribution.
624−
625− - Neither name of the University nor the names of its contributors may be
626− used to endorse or promote products derived from this software without
627− specific prior written permission.
628−
629− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
630− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
631− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
632− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
633− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
634− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
635− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
636− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
637− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
638− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
639− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
640− DAMAGE.
641−
642−deepseq LICENSE file:
643−
644− This library (deepseq) is derived from code from the GHC project which
645− is largely (c) The University of Glasgow, and distributable under a
646− BSD-style license (see below).
647−
648− -----------------------------------------------------------------------------
649−
650− The Glasgow Haskell Compiler License
651−
652− Copyright 2001-2009, The University Court of the University of Glasgow.
653− All rights reserved.
654−
655− Redistribution and use in source and binary forms, with or without
656− modification, are permitted provided that the following conditions are met:
657−
658− - Redistributions of source code must retain the above copyright notice,
659− this list of conditions and the following disclaimer.
660−
661− - Redistributions in binary form must reproduce the above copyright notice,
662− this list of conditions and the following disclaimer in the documentation
663− and/or other materials provided with the distribution.
664−
665− - Neither name of the University nor the names of its contributors may be
666− used to endorse or promote products derived from this software without
667− specific prior written permission.
668−
669− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
670− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
671− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
672− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
673− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
674− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
675− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
676− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
677− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
678− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
679− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
680− DAMAGE.
681−
682− -----------------------------------------------------------------------------
683−
684−directory LICENSE file:
685−
686− This library (libraries/base) is derived from code from two
687− sources:
688−
689− * Code from the GHC project which is largely (c) The University of
690− Glasgow, and distributable under a BSD-style license (see below),
691−
692− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
693− and freely redistributable (but see the full license for
694− restrictions).
695−
696− The full text of these licenses is reproduced below. Both of the
697− licenses are BSD-style or compatible.
698−
699− -----------------------------------------------------------------------------
700−
701− The Glasgow Haskell Compiler License
702−
703− Copyright 2004, The University Court of the University of Glasgow.
704− All rights reserved.
705−
706− Redistribution and use in source and binary forms, with or without
707− modification, are permitted provided that the following conditions are met:
708−
709− - Redistributions of source code must retain the above copyright notice,
710− this list of conditions and the following disclaimer.
711−
712− - Redistributions in binary form must reproduce the above copyright notice,
713− this list of conditions and the following disclaimer in the documentation
714− and/or other materials provided with the distribution.
715−
716− - Neither name of the University nor the names of its contributors may be
717− used to endorse or promote products derived from this software without
718− specific prior written permission.
719−
720− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
721− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
722− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
723− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
724− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
725− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
726− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
727− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
728− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
729− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
730− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
731− DAMAGE.
732−
733− -----------------------------------------------------------------------------
734−
735− Code derived from the document "Report on the Programming Language
736− Haskell 98", is distributed under the following license:
737−
738− Copyright (c) 2002 Simon Peyton Jones
739−
740− The authors intend this Report to belong to the entire Haskell
741− community, and so we grant permission to copy and distribute it for
742− any purpose, provided that it is reproduced in its entirety,
743− including this Notice. Modified versions of this Report may also be
744− copied and distributed for any purpose, provided that the modified
745− version is clearly presented as such, and that it does not claim to
746− be a definition of the Haskell 98 Language.
747−
748− -----------------------------------------------------------------------------
749−
750−dlist LICENSE file:
751−
752− Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather
753−
754− All rights reserved.
755−
756− Redistribution and use in source and binary forms, with or without
757− modification, are permitted provided that the following conditions are
758− met:
759−
760− * Redistributions of source code must retain the above copyright
761− notice, this list of conditions and the following disclaimer.
762−
763− * Redistributions in binary form must reproduce the above
764− copyright notice, this list of conditions and the following
765− disclaimer in the documentation and/or other materials provided
766− with the distribution.
767−
768− * Neither the name of Don Stewart nor the names of other
769− contributors may be used to endorse or promote products derived
770− from this software without specific prior written permission.
771−
772− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
773− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
774− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
775− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
776− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
777− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
778− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
779− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
780− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
781− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
782− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
783−
784−filepath LICENSE file:
785−
786− Copyright Neil Mitchell 2005-2015.
787− All rights reserved.
788−
789− Redistribution and use in source and binary forms, with or without
790− modification, are permitted provided that the following conditions are
791− met:
792−
793− * Redistributions of source code must retain the above copyright
794− notice, this list of conditions and the following disclaimer.
795−
796− * Redistributions in binary form must reproduce the above
797− copyright notice, this list of conditions and the following
798− disclaimer in the documentation and/or other materials provided
799− with the distribution.
800−
801− * Neither the name of Neil Mitchell nor the names of other
802− contributors may be used to endorse or promote products derived
803− from this software without specific prior written permission.
804−
805− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
806− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
807− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
808− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
809− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
810− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
811− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
812− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
813− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
814− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
815− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
816−
817−ghc-prim LICENSE file:
818−
819− This library (libraries/ghc-prim) is derived from code from several
820− sources:
821−
822− * Code from the GHC project which is largely (c) The University of
823− Glasgow, and distributable under a BSD-style license (see below),
824−
825− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
826− and freely redistributable (but see the full license for
827− restrictions).
828−
829− The full text of these licenses is reproduced below. All of the
830− licenses are BSD-style or compatible.
831−
832− -----------------------------------------------------------------------------
833−
834− The Glasgow Haskell Compiler License
835−
836− Copyright 2004, The University Court of the University of Glasgow.
837− All rights reserved.
838−
839− Redistribution and use in source and binary forms, with or without
840− modification, are permitted provided that the following conditions are met:
841−
842− - Redistributions of source code must retain the above copyright notice,
843− this list of conditions and the following disclaimer.
844−
845− - Redistributions in binary form must reproduce the above copyright notice,
846− this list of conditions and the following disclaimer in the documentation
847− and/or other materials provided with the distribution.
848−
849− - Neither name of the University nor the names of its contributors may be
850− used to endorse or promote products derived from this software without
851− specific prior written permission.
852−
853− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
854− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
855− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
856− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
857− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
858− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
859− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
860− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
861− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
862− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
863− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
864− DAMAGE.
865−
866− -----------------------------------------------------------------------------
867−
868− Code derived from the document "Report on the Programming Language
869− Haskell 98", is distributed under the following license:
870−
871− Copyright (c) 2002 Simon Peyton Jones
872−
873− The authors intend this Report to belong to the entire Haskell
874− community, and so we grant permission to copy and distribute it for
875− any purpose, provided that it is reproduced in its entirety,
876− including this Notice. Modified versions of this Report may also be
877− copied and distributed for any purpose, provided that the modified
878− version is clearly presented as such, and that it does not claim to
879− be a definition of the Haskell 98 Language.
880−
881−
882−hashable LICENSE file:
883−
884− Copyright Milan Straka 2010
885−
886− All rights reserved.
887−
888− Redistribution and use in source and binary forms, with or without
889− modification, are permitted provided that the following conditions are met:
890−
891− * Redistributions of source code must retain the above copyright
892− notice, this list of conditions and the following disclaimer.
893−
894− * Redistributions in binary form must reproduce the above
895− copyright notice, this list of conditions and the following
896− disclaimer in the documentation and/or other materials provided
897− with the distribution.
898−
899− * Neither the name of Milan Straka nor the names of other
900− contributors may be used to endorse or promote products derived
901− from this software without specific prior written permission.
902−
903− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
904− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
905− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
906− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
907− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
908− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
909− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
910− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
911− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
912− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
913− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
914−
915−haskeline LICENSE file:
916−
917− Copyright 2007-2009, Judah Jacobson.
918− All Rights Reserved.
919−
920− Redistribution and use in source and binary forms, with or without
921− modification, are permitted provided that the following conditions are met:
922−
923− - Redistribution of source code must retain the above copyright notice,
924− this list of conditions and the following disclaimer.
925−
926− - Redistribution in binary form must reproduce the above copyright notice,
927− this list of conditions and the following disclaimer in the documentation
928− and/or other materials provided with the distribution.
929−
930− THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
931− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
932− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
933− DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
934− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
935− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
936− SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
937− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
938− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
939− USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
940−
941−integer-gmp LICENSE file:
942−
943− Copyright (c) 2014, Herbert Valerio Riedel
944−
945− All rights reserved.
946−
947− Redistribution and use in source and binary forms, with or without
948− modification, are permitted provided that the following conditions are met:
949−
950− * Redistributions of source code must retain the above copyright
951− notice, this list of conditions and the following disclaimer.
952−
953− * Redistributions in binary form must reproduce the above
954− copyright notice, this list of conditions and the following
955− disclaimer in the documentation and/or other materials provided
956− with the distribution.
957−
958− * Neither the name of Herbert Valerio Riedel nor the names of other
959− contributors may be used to endorse or promote products derived
960− from this software without specific prior written permission.
961−
962− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
963− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
964− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
965− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
966− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
967− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
968− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
969− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
970− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
971− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
972− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
973−
974−language-javascript LICENSE file:
975−
976− Copyright (c)2010, Alan Zimmerman
977−
978− All rights reserved.
979−
980− Redistribution and use in source and binary forms, with or without
981− modification, are permitted provided that the following conditions are met:
982−
983− * Redistributions of source code must retain the above copyright
984− notice, this list of conditions and the following disclaimer.
985−
986− * Redistributions in binary form must reproduce the above
987− copyright notice, this list of conditions and the following
988− disclaimer in the documentation and/or other materials provided
989− with the distribution.
990−
991− * Neither the name of Alan Zimmerman nor the names of other
992− contributors may be used to endorse or promote products derived
993− from this software without specific prior written permission.
994−
995− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
996− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
997− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
998− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
999− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1000− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1001− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1002− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1003− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1004− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1005− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1006−
1007−lifted-base LICENSE file:
1008−
1009− Copyright © 2010-2012, Bas van Dijk, Anders Kaseorg
1010− All rights reserved.
1011−
1012− Redistribution and use in source and binary forms, with or without
1013− modification, are permitted provided that the following conditions are
1014− met:
1015−
1016− • Redistributions of source code must retain the above copyright
1017− notice, this list of conditions and the following disclaimer.
1018−
1019− • Redistributions in binary form must reproduce the above copyright
1020− notice, this list of conditions and the following disclaimer in the
1021− documentation and/or other materials provided with the distribution.
1022−
1023− • Neither the name of the author nor the names of other contributors
1024− may be used to endorse or promote products derived from this
1025− software without specific prior written permission.
1026−
1027− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1028− “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1029− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1030− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1031− HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1032− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1033− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1034− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1035− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1036− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1037− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1038−
1039−monad-control LICENSE file:
1040−
1041− Copyright © 2010, Bas van Dijk, Anders Kaseorg
1042− All rights reserved.
1043−
1044− Redistribution and use in source and binary forms, with or without
1045− modification, are permitted provided that the following conditions are
1046− met:
1047−
1048− • Redistributions of source code must retain the above copyright
1049− notice, this list of conditions and the following disclaimer.
1050−
1051− • Redistributions in binary form must reproduce the above copyright
1052− notice, this list of conditions and the following disclaimer in the
1053− documentation and/or other materials provided with the distribution.
1054−
1055− • Neither the name of the author nor the names of other contributors
1056− may be used to endorse or promote products derived from this
1057− software without specific prior written permission.
1058−
1059− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1060− “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1061− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1062− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1063− HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1064− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1065− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1066− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1067− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1068− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1069− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1070−
1071−mtl LICENSE file:
1072−
1073− The Glasgow Haskell Compiler License
1074−
1075− Copyright 2004, The University Court of the University of Glasgow.
1076− All rights reserved.
1077−
1078− Redistribution and use in source and binary forms, with or without
1079− modification, are permitted provided that the following conditions are met:
1080−
1081− - Redistributions of source code must retain the above copyright notice,
1082− this list of conditions and the following disclaimer.
1083−
1084− - Redistributions in binary form must reproduce the above copyright notice,
1085− this list of conditions and the following disclaimer in the documentation
1086− and/or other materials provided with the distribution.
1087−
1088− - Neither name of the University nor the names of its contributors may be
1089− used to endorse or promote products derived from this software without
1090− specific prior written permission.
1091−
1092− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1093− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1094− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1095− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1096− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1097− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1098− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1099− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1100− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1101− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1102− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1103− DAMAGE.
1104−
1105−nats LICENSE file:
1106−
1107− Copyright 2011-2014 Edward Kmett
1108−
1109− All rights reserved.
1110−
1111− Redistribution and use in source and binary forms, with or without
1112− modification, are permitted provided that the following conditions
1113− are met:
1114−
1115− 1. Redistributions of source code must retain the above copyright
1116− notice, this list of conditions and the following disclaimer.
1117−
1118− 2. Redistributions in binary form must reproduce the above copyright
1119− notice, this list of conditions and the following disclaimer in the
1120− documentation and/or other materials provided with the distribution.
1121−
1122− 3. Neither the name of the author nor the names of his contributors
1123− may be used to endorse or promote products derived from this software
1124− without specific prior written permission.
1125−
1126− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1127− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1128− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1129− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1130− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1131− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1132− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1133− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1134− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1135− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1136− POSSIBILITY OF SUCH DAMAGE.
1137−
1138−optparse-applicative LICENSE file:
1139−
1140− Copyright (c) 2012, Paolo Capriotti
1141−
1142− All rights reserved.
1143−
1144− Redistribution and use in source and binary forms, with or without
1145− modification, are permitted provided that the following conditions are met:
1146−
1147− * Redistributions of source code must retain the above copyright
1148− notice, this list of conditions and the following disclaimer.
1149−
1150− * Redistributions in binary form must reproduce the above
1151− copyright notice, this list of conditions and the following
1152− disclaimer in the documentation and/or other materials provided
1153− with the distribution.
1154−
1155− * Neither the name of Paolo Capriotti nor the names of other
1156− contributors may be used to endorse or promote products derived
1157− from this software without specific prior written permission.
1158−
1159− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1160− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1161− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1162− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1163− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1164− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1165− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1166− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1167− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1168− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1169− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1170−
1171−parsec LICENSE file:
1172−
1173− Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.
1174−
1175− Redistribution and use in source and binary forms, with or without
1176− modification, are permitted provided that the following conditions are met:
1177−
1178− * Redistributions of source code must retain the above copyright notice,
1179− this list of conditions and the following disclaimer.
1180− * Redistributions in binary form must reproduce the above copyright
1181− notice, this list of conditions and the following disclaimer in the
1182− documentation and/or other materials provided with the distribution.
1183−
1184− This software is provided by the copyright holders "as is" and any express or
1185− implied warranties, including, but not limited to, the implied warranties of
1186− merchantability and fitness for a particular purpose are disclaimed. In no
1187− event shall the copyright holders be liable for any direct, indirect,
1188− incidental, special, exemplary, or consequential damages (including, but not
1189− limited to, procurement of substitute goods or services; loss of use, data,
1190− or profits; or business interruption) however caused and on any theory of
1191− liability, whether in contract, strict liability, or tort (including
1192− negligence or otherwise) arising in any way out of the use of this software,
1193− even if advised of the possibility of such damage.
1194−
1195−pattern-arrows LICENSE file:
1196−
1197− The MIT License (MIT)
1198−
1199− Copyright (c) 2013 Phil Freeman
1200−
1201− Permission is hereby granted, free of charge, to any person obtaining a copy of
1202− this software and associated documentation files (the "Software"), to deal in
1203− the Software without restriction, including without limitation the rights to
1204− use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
1205− the Software, and to permit persons to whom the Software is furnished to do so,
1206− subject to the following conditions:
1207−
1208− The above copyright notice and this permission notice shall be included in all
1209− copies or substantial portions of the Software.
1210−
1211− THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
1212− IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
1213− FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
1214− COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
1215− IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
1216− CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
1217−
1218−pretty LICENSE file:
1219−
1220− This library (libraries/pretty) is derived from code from
1221− the GHC project which is largely (c) The University of
1222− Glasgow, and distributable under a BSD-style license (see below).
1223−
1224− -----------------------------------------------------------------------------
1225−
1226− The Glasgow Haskell Compiler License
1227−
1228− Copyright 2004, The University Court of the University of Glasgow.
1229− All rights reserved.
1230−
1231− Redistribution and use in source and binary forms, with or without
1232− modification, are permitted provided that the following conditions are met:
1233−
1234− - Redistributions of source code must retain the above copyright notice,
1235− this list of conditions and the following disclaimer.
1236−
1237− - Redistributions in binary form must reproduce the above copyright notice,
1238− this list of conditions and the following disclaimer in the documentation
1239− and/or other materials provided with the distribution.
1240−
1241− - Neither name of the University nor the names of its contributors may be
1242− used to endorse or promote products derived from this software without
1243− specific prior written permission.
1244−
1245− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1246− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1247− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1248− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1249− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1250− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1251− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1252− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1253− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1254− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1255− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1256− DAMAGE.
1257−
1258− -----------------------------------------------------------------------------
1259−
1260−primitive LICENSE file:
1261−
1262− Copyright (c) 2008-2009, Roman Leshchinskiy
1263− All rights reserved.
1264−
1265− Redistribution and use in source and binary forms, with or without
1266− modification, are permitted provided that the following conditions are met:
1267−
1268− - Redistributions of source code must retain the above copyright notice,
1269− this list of conditions and the following disclaimer.
1270−
1271− - Redistributions in binary form must reproduce the above copyright notice,
1272− this list of conditions and the following disclaimer in the documentation
1273− and/or other materials provided with the distribution.
1274−
1275− - Neither name of the University nor the names of its contributors may be
1276− used to endorse or promote products derived from this software without
1277− specific prior written permission.
1278−
1279− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1280− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1281− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1282− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1283− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1284− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1285− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1286− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1287− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1288− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1289− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1290− DAMAGE.
1291−
1292−
1293−process LICENSE file:
1294−
1295− This library (libraries/process) is derived from code from two
1296− sources:
1297−
1298− * Code from the GHC project which is largely (c) The University of
1299− Glasgow, and distributable under a BSD-style license (see below),
1300−
1301− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1302− and freely redistributable (but see the full license for
1303− restrictions).
1304−
1305− The full text of these licenses is reproduced below. Both of the
1306− licenses are BSD-style or compatible.
1307−
1308− -----------------------------------------------------------------------------
1309−
1310− The Glasgow Haskell Compiler License
1311−
1312− Copyright 2004, The University Court of the University of Glasgow.
1313− All rights reserved.
1314−
1315− Redistribution and use in source and binary forms, with or without
1316− modification, are permitted provided that the following conditions are met:
1317−
1318− - Redistributions of source code must retain the above copyright notice,
1319− this list of conditions and the following disclaimer.
1320−
1321− - Redistributions in binary form must reproduce the above copyright notice,
1322− this list of conditions and the following disclaimer in the documentation
1323− and/or other materials provided with the distribution.
1324−
1325− - Neither name of the University nor the names of its contributors may be
1326− used to endorse or promote products derived from this software without
1327− specific prior written permission.
1328−
1329− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1330− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1331− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1332− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1333− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1334− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1335− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1336− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1337− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1338− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1339− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1340− DAMAGE.
1341−
1342− -----------------------------------------------------------------------------
1343−
1344− Code derived from the document "Report on the Programming Language
1345− Haskell 98", is distributed under the following license:
1346−
1347− Copyright (c) 2002 Simon Peyton Jones
1348−
1349− The authors intend this Report to belong to the entire Haskell
1350− community, and so we grant permission to copy and distribute it for
1351− any purpose, provided that it is reproduced in its entirety,
1352− including this Notice. Modified versions of this Report may also be
1353− copied and distributed for any purpose, provided that the modified
1354− version is clearly presented as such, and that it does not claim to
1355− be a definition of the Haskell 98 Language.
1356−
1357− -----------------------------------------------------------------------------
1358−
1359−rts LICENSE file:
1360−
1361− Package not found: No such package in package index
1362−
1363−safe LICENSE file:
1364−
1365− Copyright Neil Mitchell 2007-2015.
1366− All rights reserved.
1367−
1368− Redistribution and use in source and binary forms, with or without
1369− modification, are permitted provided that the following conditions are
1370− met:
1371−
1372− * Redistributions of source code must retain the above copyright
1373− notice, this list of conditions and the following disclaimer.
1374−
1375− * Redistributions in binary form must reproduce the above
1376− copyright notice, this list of conditions and the following
1377− disclaimer in the documentation and/or other materials provided
1378− with the distribution.
1379−
1380− * Neither the name of Neil Mitchell nor the names of other
1381− contributors may be used to endorse or promote products derived
1382− from this software without specific prior written permission.
1383−
1384− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1385− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1386− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1387− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1388− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1389− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1390− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1391− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1392− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1393− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1394− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1395−
1396−scientific LICENSE file:
1397−
1398− Copyright (c) 2013, Bas van Dijk
1399−
1400− All rights reserved.
1401−
1402− Redistribution and use in source and binary forms, with or without
1403− modification, are permitted provided that the following conditions are met:
1404−
1405− * Redistributions of source code must retain the above copyright
1406− notice, this list of conditions and the following disclaimer.
1407−
1408− * Redistributions in binary form must reproduce the above
1409− copyright notice, this list of conditions and the following
1410− disclaimer in the documentation and/or other materials provided
1411− with the distribution.
1412−
1413− * Neither the name of Bas van Dijk nor the names of other
1414− contributors may be used to endorse or promote products derived
1415− from this software without specific prior written permission.
1416−
1417− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1418− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1419− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1420− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1421− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1422− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1423− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1424− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1425− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1426− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1427− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1428−
1429−semigroups LICENSE file:
1430−
1431− Copyright 2011-2015 Edward Kmett
1432−
1433− All rights reserved.
1434−
1435− Redistribution and use in source and binary forms, with or without
1436− modification, are permitted provided that the following conditions
1437− are met:
1438−
1439− 1. Redistributions of source code must retain the above copyright
1440− notice, this list of conditions and the following disclaimer.
1441−
1442− 2. Redistributions in binary form must reproduce the above copyright
1443− notice, this list of conditions and the following disclaimer in the
1444− documentation and/or other materials provided with the distribution.
1445−
1446− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1447− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1448− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1449− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1450− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1451− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1452− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1453− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1454− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1455− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1456− POSSIBILITY OF SUCH DAMAGE.
1457−
1458−split LICENSE file:
1459−
1460− Copyright (c) 2008 Brent Yorgey, Louis Wasserman
1461−
1462− All rights reserved.
1463−
1464− Redistribution and use in source and binary forms, with or without
1465− modification, are permitted provided that the following conditions
1466− are met:
1467− 1. Redistributions of source code must retain the above copyright
1468− notice, this list of conditions and the following disclaimer.
1469− 2. Redistributions in binary form must reproduce the above copyright
1470− notice, this list of conditions and the following disclaimer in the
1471− documentation and/or other materials provided with the distribution.
1472− 3. Neither the name of the author nor the names of other contributors
1473− may be used to endorse or promote products derived from this software
1474− without specific prior written permission.
1475−
1476− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
1477− ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
1478− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
1479− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
1480− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1481− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1482− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1483− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1484− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1485− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1486− SUCH DAMAGE.
1487−
1488−stm LICENSE file:
1489−
1490− The Glasgow Haskell Compiler License
1491−
1492− Copyright 2004, The University Court of the University of Glasgow.
1493− All rights reserved.
1494−
1495− Redistribution and use in source and binary forms, with or without
1496− modification, are permitted provided that the following conditions are met:
1497−
1498− - Redistributions of source code must retain the above copyright notice,
1499− this list of conditions and the following disclaimer.
1500−
1501− - Redistributions in binary form must reproduce the above copyright notice,
1502− this list of conditions and the following disclaimer in the documentation
1503− and/or other materials provided with the distribution.
1504−
1505− - Neither name of the University nor the names of its contributors may be
1506− used to endorse or promote products derived from this software without
1507− specific prior written permission.
1508−
1509− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1510− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1511− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1512− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1513− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1514− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1515− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1516− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1517− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1518− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1519− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1520− DAMAGE.
1521−
1522−syb LICENSE file:
1523−
1524− This library (libraries/syb) is derived from code from several
1525− sources:
1526−
1527− * Code from the GHC project which is largely (c) The University of
1528− Glasgow, and distributable under a BSD-style license (see below),
1529−
1530− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1531− and freely redistributable (but see the full license for
1532− restrictions).
1533−
1534− * Code from the Haskell Foreign Function Interface specification,
1535− which is (c) Manuel M. T. Chakravarty and freely redistributable
1536− (but see the full license for restrictions).
1537−
1538− The full text of these licenses is reproduced below. All of the
1539− licenses are BSD-style or compatible.
1540−
1541− -----------------------------------------------------------------------------
1542−
1543− The Glasgow Haskell Compiler License
1544−
1545− Copyright 2004, The University Court of the University of Glasgow.
1546− All rights reserved.
1547−
1548− Redistribution and use in source and binary forms, with or without
1549− modification, are permitted provided that the following conditions are met:
1550−
1551− - Redistributions of source code must retain the above copyright notice,
1552− this list of conditions and the following disclaimer.
1553−
1554− - Redistributions in binary form must reproduce the above copyright notice,
1555− this list of conditions and the following disclaimer in the documentation
1556− and/or other materials provided with the distribution.
1557−
1558− - Neither name of the University nor the names of its contributors may be
1559− used to endorse or promote products derived from this software without
1560− specific prior written permission.
1561−
1562− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1563− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1564− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1565− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1566− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1567− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1568− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1569− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1570− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1571− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1572− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1573− DAMAGE.
1574−
1575− -----------------------------------------------------------------------------
1576−
1577− Code derived from the document "Report on the Programming Language
1578− Haskell 98", is distributed under the following license:
1579−
1580− Copyright (c) 2002 Simon Peyton Jones
1581−
1582− The authors intend this Report to belong to the entire Haskell
1583− community, and so we grant permission to copy and distribute it for
1584− any purpose, provided that it is reproduced in its entirety,
1585− including this Notice. Modified versions of this Report may also be
1586− copied and distributed for any purpose, provided that the modified
1587− version is clearly presented as such, and that it does not claim to
1588− be a definition of the Haskell 98 Language.
1589−
1590− -----------------------------------------------------------------------------
1591−
1592− Code derived from the document "The Haskell 98 Foreign Function
1593− Interface, An Addendum to the Haskell 98 Report" is distributed under
1594− the following license:
1595−
1596− Copyright (c) 2002 Manuel M. T. Chakravarty
1597−
1598− The authors intend this Report to belong to the entire Haskell
1599− community, and so we grant permission to copy and distribute it for
1600− any purpose, provided that it is reproduced in its entirety,
1601− including this Notice. Modified versions of this Report may also be
1602− copied and distributed for any purpose, provided that the modified
1603− version is clearly presented as such, and that it does not claim to
1604− be a definition of the Haskell 98 Foreign Function Interface.
1605−
1606− -----------------------------------------------------------------------------
1607−
1608−template-haskell LICENSE file:
1609−
1610−
1611− The Glasgow Haskell Compiler License
1612−
1613− Copyright 2002-2007, The University Court of the University of Glasgow.
1614− All rights reserved.
1615−
1616− Redistribution and use in source and binary forms, with or without
1617− modification, are permitted provided that the following conditions are met:
1618−
1619− - Redistributions of source code must retain the above copyright notice,
1620− this list of conditions and the following disclaimer.
1621−
1622− - Redistributions in binary form must reproduce the above copyright notice,
1623− this list of conditions and the following disclaimer in the documentation
1624− and/or other materials provided with the distribution.
1625−
1626− - Neither name of the University nor the names of its contributors may be
1627− used to endorse or promote products derived from this software without
1628− specific prior written permission.
1629−
1630− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1631− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1632− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1633− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1634− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1635− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1636− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1637− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1638− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1639− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1640− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1641− DAMAGE.
1642−
1643−
1644−terminfo LICENSE file:
1645−
1646− Copyright 2007, Judah Jacobson.
1647− All Rights Reserved.
1648−
1649− Redistribution and use in source and binary forms, with or without
1650− modification, are permitted provided that the following conditions are met:
1651−
1652− - Redistribution of source code must retain the above copyright notice,
1653− this list of conditions and the following disclamer.
1654−
1655− - Redistribution in binary form must reproduce the above copyright notice,
1656− this list of conditions and the following disclamer in the documentation
1657− and/or other materials provided with the distribution.
1658−
1659− THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
1660− EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1661− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1662− DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
1663− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1664− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1665− SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1666− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1667− OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
1668− USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1669−
1670−text LICENSE file:
1671−
1672− Copyright (c) 2008-2009, Tom Harper
1673− All rights reserved.
1674−
1675− Redistribution and use in source and binary forms, with or without
1676− modification, are permitted provided that the following conditions
1677− are met:
1678−
1679− * Redistributions of source code must retain the above copyright
1680− notice, this list of conditions and the following disclaimer.
1681−
1682− * Redistributions in binary form must reproduce the above
1683− copyright notice, this list of conditions and the following
1684− disclaimer in the documentation and/or other materials provided
1685− with the distribution.
1686−
1687− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1688− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1689− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1690− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1691− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1692− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1693− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1694− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1695− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1696− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1697− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1698−
1699−time LICENSE file:
1700−
1701− TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.
1702− Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.
1703−
1704− Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
1705−
1706− - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
1707−
1708− - 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.
1709−
1710− 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.
1711−
1712−transformers LICENSE file:
1713−
1714− The Glasgow Haskell Compiler License
1715−
1716− Copyright 2004, The University Court of the University of Glasgow.
1717− All rights reserved.
1718−
1719− Redistribution and use in source and binary forms, with or without
1720− modification, are permitted provided that the following conditions are met:
1721−
1722− - Redistributions of source code must retain the above copyright notice,
1723− this list of conditions and the following disclaimer.
1724−
1725− - Redistributions in binary form must reproduce the above copyright notice,
1726− this list of conditions and the following disclaimer in the documentation
1727− and/or other materials provided with the distribution.
1728−
1729− - Neither name of the University nor the names of its contributors may be
1730− used to endorse or promote products derived from this software without
1731− specific prior written permission.
1732−
1733− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1734− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1735− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1736− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1737− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1738− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1739− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1740− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1741− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1742− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1743− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1744− DAMAGE.
1745−
1746−transformers-base LICENSE file:
1747−
1748− Copyright (c) 2011, Mikhail Vorozhtsov, Bas van Dijk
1749− All rights reserved.
1750−
1751− Redistribution and use in source and binary forms, with or without
1752− modification, are permitted provided that the following conditions are met:
1753−
1754− - Redistributions of source code must retain the above copyright notice,
1755− this list of conditions and the following disclaimer.
1756− - Redistributions in binary form must reproduce the above copyright
1757− notice, this list of conditions and the following disclaimer in the
1758− documentation and/or other materials provided with the distribution.
1759− - Neither the names of the copyright owners nor the names of the
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−
1776−transformers-compat LICENSE file:
1777−
1778− Copyright 2012 Edward Kmett
1779−
1780− All rights reserved.
1781−
1782− Redistribution and use in source and binary forms, with or without
1783− modification, are permitted provided that the following conditions
1784− are met:
1785−
1786− 1. Redistributions of source code must retain the above copyright
1787− notice, this list of conditions and the following disclaimer.
1788−
1789− 2. Redistributions in binary form must reproduce the above copyright
1790− notice, this list of conditions and the following disclaimer in the
1791− documentation and/or other materials provided with the distribution.
1792−
1793− 3. Neither the name of the author nor the names of his contributors
1794− may be used to endorse or promote products derived from this software
1795− without specific prior written permission.
1796−
1797− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1798− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1799− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1800− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1801− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1802− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1803− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1804− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1805− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1806− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1807− POSSIBILITY OF SUCH DAMAGE.
1808−
1809−unix LICENSE file:
1810−
1811− The Glasgow Haskell Compiler License
1812−
1813− Copyright 2004, The University Court of the University of Glasgow.
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− - Redistributions of source code must retain the above copyright notice,
1820− this list of conditions and the following disclaimer.
1821−
1822− - Redistributions in binary form must reproduce the above copyright notice,
1823− this list of conditions and the following disclaimer in the documentation
1824− and/or other materials provided with the distribution.
1825−
1826− - Neither name of the University nor the names of its contributors may be
1827− used to endorse or promote products derived from this software without
1828− specific prior written permission.
1829−
1830− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1831− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1832− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1833− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1834− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1835− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1836− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1837− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1838− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1839− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1840− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1841− DAMAGE.
1842−
1843−unordered-containers LICENSE file:
1844−
1845− Copyright (c) 2010, Johan Tibell
1846−
1847− All rights reserved.
1848−
1849− Redistribution and use in source and binary forms, with or without
1850− modification, are permitted provided that the following conditions are met:
1851−
1852− * Redistributions of source code must retain the above copyright
1853− notice, this list of conditions and the following disclaimer.
1854−
1855− * Redistributions in binary form must reproduce the above
1856− copyright notice, this list of conditions and the following
1857− disclaimer in the documentation and/or other materials provided
1858− with the distribution.
1859−
1860− * Neither the name of Johan Tibell nor the names of other
1861− contributors may be used to endorse or promote products derived
1862− from this software without specific prior written permission.
1863−
1864− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1865− "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1866− LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1867− A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1868− OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1869− SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1870− LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1871− DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1872− THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1873− (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1874− OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1875−
1876−utf8-string LICENSE file:
1877−
1878− * Copyright (c) 2007, Galois Inc.
1879− * All rights reserved.
1880− *
1881− * Redistribution and use in source and binary forms, with or without
1882− * modification, are permitted provided that the following conditions are met:
1883− * * Redistributions of source code must retain the above copyright
1884− * notice, this list of conditions and the following disclaimer.
1885− * * Redistributions in binary form must reproduce the above copyright
1886− * notice, this list of conditions and the following disclaimer in the
1887− * documentation and/or other materials provided with the distribution.
1888− * * Neither the name of Galois Inc. nor the
1889− * names of its contributors may be used to endorse or promote products
1890− * derived from this software without specific prior written permission.
1891− *
1892− * THIS SOFTWARE IS PROVIDED BY Galois Inc. ``AS IS'' AND ANY
1893− * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1894− * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1895− * DISCLAIMED. IN NO EVENT SHALL Galois Inc. BE LIABLE FOR ANY
1896− * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
1897− * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
1898− * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1899− * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1900− * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
1901− * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1902−
1903−vector LICENSE file:
1904−
1905− Copyright (c) 2008-2012, Roman Leshchinskiy
1906− All rights reserved.
1907−
1908− Redistribution and use in source and binary forms, with or without
1909− modification, are permitted provided that the following conditions are met:
1910−
1911− - Redistributions of source code must retain the above copyright notice,
1912− this list of conditions and the following disclaimer.
1913−
1914− - Redistributions in binary form must reproduce the above copyright notice,
1915− this list of conditions and the following disclaimer in the documentation
1916− and/or other materials provided with the distribution.
1917−
1918− - Neither name of the University nor the names of its contributors may be
1919− used to endorse or promote products derived from this software without
1920− specific prior written permission.
1921−
1922− THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1923− GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1924− INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1925− FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1926− UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1927− FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1928− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1929− SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1930− CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1931− LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1932− OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1933− DAMAGE.
1934−
1935−
1936−void LICENSE file:
1937−
1938− Copyright 2015 Edward Kmett
1939−
1940− All rights reserved.
1941−
1942− Redistribution and use in source and binary forms, with or without
1943− modification, are permitted provided that the following conditions
1944− are met:
1945−
1946− 1. Redistributions of source code must retain the above copyright
1947− notice, this list of conditions and the following disclaimer.
1948−
1949− 2. Redistributions in binary form must reproduce the above copyright
1950− notice, this list of conditions and the following disclaimer in the
1951− documentation and/or other materials provided with the distribution.
1952−
1953− 3. Neither the name of the author nor the names of his contributors
1954− may be used to endorse or promote products derived from this software
1955− without specific prior written permission.
1956−
1957− THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1958− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1959− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1960− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1961− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1962− DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1963− OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1964− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1965− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1966− ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1967− POSSIBILITY OF SUCH DAMAGE.
196810
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−19
@@ -1,28 +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)
30+* For `pscpp`, a C++11-capable toolchain, e.g. recent versions of clang, gcc, Microsoft Visual Studio
31+ * GNU Make + `psc-package` is the default supported build tool, but you should be able to use your favorite package manager, C++ build system, tools, debuggers, etc.
32+* For `psgo`, the [Go toolchain](https://golang.org) for your system
33+ * You can use your favorite PureScript package manager and build tools – but for simplicity, [`spago`](https://github.com/spacchetti/spago) is recommended.
34+
35+
36+#### For more information and a Getting Started guide, please see
37+* [`pscpp`](https://github.com/andyarvanitis/purescript-native/blob/cpp/README-cpp.md)
38+* [`psgo`](https://github.com/andyarvanitis/purescript-native/blob/golang/README-go.md)
39+
40+
41+---
Setup.hs−4
@@ -1,6 +1,2 @@
1−module Main where
2−
31import Distribution.Simple
4−
5−main :: IO ()
62main = defaultMain
app/Main.hsnew file+250
@@ -0,0 +1,250 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RankNTypes #-}
3+{-# LANGUAGE TemplateHaskell #-}
4+
5+module Main where
6+
7+import Control.Monad (when)
8+import qualified Control.Monad.Parallel as Par
9+import Data.Aeson
10+import Data.Aeson.Types
11+import Data.Char
12+import Data.FileEmbed (embedFile)
13+import Data.List (delete, intercalate, isPrefixOf, nub, partition, (\\))
14+import Data.Maybe
15+import Data.Monoid ((<>))
16+import Data.Version
17+import Control.Monad.Supply
18+import Control.Monad.Supply.Class
19+import Text.Printf
20+
21+import System.Environment
22+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getCurrentDirectory, getModificationTime)
23+import System.FilePath ((</>), joinPath, splitDirectories, takeDirectory)
24+import System.FilePath.Find
25+import System.Process
26+
27+import Data.Text (Text)
28+import qualified Data.Text as T
29+import qualified Data.Text.Encoding as T
30+import qualified Data.Text.Lazy as L
31+import qualified Data.Text.Lazy.Encoding as L
32+import qualified Data.ByteString as B
33+
34+import Development.GitRev
35+
36+import Language.PureScript.AST.Literals
37+import Language.PureScript.CoreFn
38+import Language.PureScript.CoreFn.FromJSON
39+
40+import CodeGen.IL
41+import CodeGen.IL.Common
42+import CodeGen.IL.Printer
43+
44+import Tests
45+
46+data Command = Build | Run (Maybe String)
47+
48+parseJson :: Text -> Value
49+parseJson text
50+ | Just fileJson <- decode . L.encodeUtf8 $ L.fromStrict text = fileJson
51+ | otherwise = error "Bad json"
52+
53+jsonToModule :: Value -> Module Ann
54+jsonToModule value =
55+ case parse moduleFromJSON value of
56+ Success (_, r) -> r
57+ _ -> error "Failed parsing corefn. Psgo currently supports purescript <= 0.13.8"
58+
59+splitArgs :: [String] -> ([String], Maybe String, [String])
60+splitArgs args =
61+ let (opts, files) = partition (isPrefixOf "--") args
62+ opts' = (map . map) toLower opts
63+ (moduleName, files') =
64+ if null files
65+ then (Nothing, files)
66+ else
67+ if "--run" `elem` opts' && length (files) >= 1
68+ then do
69+ let file0 = head files
70+ files' = tail files
71+ case file0 of
72+ "Main.main" -> (Just "Main", files')
73+ "Test.Main.main" -> (Just "Test.Main", files')
74+ _ -> (Nothing, files)
75+ else (Nothing, files)
76+ in (opts, moduleName, files')
77+
78+main :: IO ()
79+main = do
80+ args <- getArgs
81+ -- let (opts, files) = partition (isPrefixOf "--") args
82+ let (opts, moduleName, files) = splitArgs args
83+ opts' = (map . map) toLower opts
84+ if "--tests" `elem` opts'
85+ then runTests
86+ else do
87+ if "--help" `elem` opts' || "--version" `elem` opts'
88+ then do
89+ when ("--help" `elem` opts') $ do
90+ putStrLn help
91+ when ("--version" `elem` opts') $ do
92+ let branch = $(gitBranch)
93+ details | branch == "golang" = "master, commit " ++ $(gitHash)
94+ | otherwise = branch
95+ putStrLn $ details ++ if $(gitDirty) then " (DIRTY)" else ""
96+ else do
97+ if null files
98+ then do
99+ currentDir <- getCurrentDirectory
100+ processFiles opts' [currentDir]
101+ else
102+ processFiles opts' files
103+ if "--run" `elem` opts
104+ then runBuildTool $ Run moduleName
105+ else when ("--no-build" `notElem` opts) $
106+ runBuildTool Build
107+ return ()
108+ where
109+ processFiles :: [String] -> [FilePath] -> IO ()
110+ processFiles opts [file] = do
111+ isDir <- doesDirectoryExist file
112+ if isDir then do
113+ files <- find always (fileName ==? corefn) file
114+ if null files
115+ then errorNoCorefnFiles
116+ else generateFiles opts files
117+ else generateFiles opts [file]
118+ processFiles opts files = do
119+ generateFiles opts files
120+ basePath :: [FilePath] -> FilePath
121+ basePath files =
122+ let filepath = takeDirectory (head files) in
123+ joinPath $ (init $ splitDirectories filepath)
124+ generateFiles :: [String] -> [FilePath] -> IO ()
125+ generateFiles opts files = do
126+ let baseOutpath = basePath files
127+ writeSupportFiles baseOutpath
128+ Par.mapM (generateCode opts baseOutpath) files
129+ return ()
130+ runBuildTool :: Command -> IO ()
131+ runBuildTool cmd = do
132+ project <- projectEnv
133+ case cmd of
134+ Build -> do
135+ callProcess "go" ["build", T.unpack project </> modPrefix' </> "Main"]
136+ Run moduleName -> do
137+ callProcess "go" ["run", T.unpack project </> modPrefix' </> fromMaybe "Main" moduleName]
138+ return ()
139+
140+generateCode :: [String] -> FilePath -> FilePath -> IO ()
141+generateCode opts baseOutpath jsonFile = do
142+ jsonModTime <- getModificationTime jsonFile
143+ let filepath = takeDirectory jsonFile
144+ dirparts = splitDirectories $ filepath
145+ mname = last dirparts
146+ basedir = joinPath $ init dirparts
147+ mname' = T.pack mname
148+ possibleFileName = basedir </> (T.unpack mname') </> implFileName mname'
149+ exists <- doesFileExist possibleFileName
150+ if exists
151+ then do
152+ modTime <- getModificationTime possibleFileName
153+ when (modTime < jsonModTime) $
154+ transpile opts baseOutpath jsonFile
155+ else transpile opts baseOutpath jsonFile
156+
157+transpile :: [String] -> FilePath -> FilePath -> IO ()
158+transpile opts baseOutpath jsonFile = do
159+ jsonText <- T.decodeUtf8 <$> B.readFile jsonFile
160+ project <- projectEnv
161+ let module' = jsonToModule $ parseJson jsonText
162+ ((_, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToIL module' project)
163+ let mn = moduleNameToIL' $ moduleName module'
164+ implementation = prettyPrintIL asts
165+ outpath = joinPath [baseOutpath, T.unpack mn]
166+ implPath = outpath </> implFileName mn
167+ createDirectoryIfMissing True outpath
168+ putStrLn implPath
169+ B.writeFile implPath $ T.encodeUtf8 (implHeader <> implementation <> implFooter)
170+
171+writeSupportFiles :: FilePath -> IO ()
172+writeSupportFiles baseOutpath = do
173+ currentDir <- getCurrentDirectory
174+ let outputdir = T.pack $ baseOutpath \\ currentDir
175+ ffiOutpath = currentDir </> subdir
176+ createDirectoryIfMissing True baseOutpath
177+ createDirectoryIfMissing True ffiOutpath
178+ writeModuleFile outputdir currentDir $(embedFile "support/go.mod.working")
179+ writeModuleFile outputdir baseOutpath $(embedFile "support/go.mod.output")
180+ writeModuleFile outputdir ffiOutpath $(embedFile "support/go.mod.ffi-loader")
181+ writeLoaderFile ffiOutpath $(embedFile "support/ffi-loader.go")
182+ where
183+ writeModuleFile :: Text -> FilePath -> B.ByteString -> IO ()
184+ writeModuleFile outputdir path modText = do
185+ let goModSource = path </> "go.mod"
186+ goModSourceExists <- doesFileExist goModSource
187+ when (not goModSourceExists) $ do
188+ project <- projectEnv
189+ let project' = T.unpack project
190+ outputdir' = tail $ T.unpack outputdir
191+ modText' = T.replace "$PROJECT" project $ T.decodeUtf8 modText
192+ replaceLoader = project' </> ffiLoader' <> "=." </> subdir
193+ replaceOutput = project' </> modPrefix' <> "=." </> outputdir'
194+ B.writeFile goModSource $ T.encodeUtf8 modText'
195+ callProcess "go" ["mod", "edit", "-replace", replaceLoader]
196+ callProcess "go" ["mod", "edit", "-replace", replaceOutput]
197+ callProcess "go" ["clean", "-modcache"]
198+ writeLoaderFile :: FilePath -> B.ByteString -> IO ()
199+ writeLoaderFile ffiOutpath loaderText = do
200+ let loaderSource = ffiOutpath </> "ffi_loader.go"
201+ loaderSourceExists <- doesFileExist loaderSource
202+ when (not loaderSourceExists) $ do
203+ B.writeFile loaderSource loaderText
204+
205+implFileName :: Text -> FilePath
206+implFileName mn = ((\c -> if c == '.' then '_' else c) <$> T.unpack mn) <> ".go"
207+
208+projectEnv :: IO Text
209+projectEnv = do
210+ T.pack . fromMaybe defaultProject <$> lookupEnv goproject
211+
212+help :: String
213+help = "Usage: psgo OPTIONS COREFN-FILES\n\
214+ \ PureScript to native (via go) compiler\n\n\
215+ \Available options:\n\
216+ \ --help Show this help text\n\n\
217+ \ --version Show the version number\n\n\
218+ \ --run Run the generated go code directly, without building an\n\
219+ \ executable\n\
220+ \ --no-build Generate go source files, but do not build an executable\n\
221+ \ --tests Run test cases (under construction)\n\n\
222+ \See also:\n\
223+ \ purs compile --help\n"
224+
225+corefn :: String
226+corefn = "corefn.json"
227+
228+goSrc :: String
229+goSrc = ".go"
230+
231+goproject :: String
232+goproject = "GOPROJECT"
233+
234+defaultProject :: String
235+defaultProject = "project.localhost"
236+
237+modPrefix' :: String
238+modPrefix' = T.unpack modPrefix
239+
240+ffiLoader' :: String
241+ffiLoader' = T.unpack ffiLoader
242+
243+subdir :: String
244+subdir = T.unpack modLabel
245+
246+errorNoCorefnFiles :: IO ()
247+errorNoCorefnFiles = do
248+ ioError . userError $ "no compiled purescript '" <> corefn <> "' files found –\n" <>
249+ " make sure to use the '--codegen corefn' option with your purs\n" <>
250+ " project build tool"
bundle/.gitignoredeleted−3
@@ -1,3 +0,0 @@
1−build/
2−*.tar.gz
3−*.sha
bundle/READMEdeleted−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−23
@@ -1,23 +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 { a :: a }
18− | E Void
19−
20−derive instance genericA :: (Generic a) => Generic (A a)
21−
22−main :: forall eff. Eff (console :: CONSOLE | eff) Unit
23−main = Control.Monad.Eff.Console.log (gShow (D { a: C [ A 1.0 "test", B 42, D { a: 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/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/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/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/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/EmptyDo.pursdeleted−6
@@ -1,6 +0,0 @@
1−-- @shouldFailWith ErrorParsingModule
2−
3−module Main where
4−
5−main = do
6−
examples/failing/ExtraRecordField.pursdeleted−10
@@ -1,10 +0,0 @@
1−-- @shouldFailWith PropertyIsMissing
2−-- TODO: Make this fail with a new error ExtraProperty instead.
3−module ExtraRecordField where
4−
5−import Prelude ((<>))
6−
7−full :: { first :: String, last :: String } -> String
8−full p = p.first <> " " <> p.last
9−
10−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/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−11
@@ -1,11 +0,0 @@
1−-- @shouldFailWith TypesDoNotUnify
2−-- TODO: Update type checker to make this fail with PropertyIsMissing instead.
3−module MissingRecordField where
4−
5−import Prelude ((>))
6−
7−john = { first: "John", last: "Smith" }
8−
9−isOver50 p = p.age > 50.0
10−
11−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−8
@@ -1,8 +0,0 @@
1−-- @shouldFailWith CycleInDeclaration
2−module MutRec where
3−
4−import Prelude
5−
6−x = y
7−
8−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/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/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/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/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 Partial
6−
7−head :: forall a. (Partial) => Array a -> a
8−head [x] = x
9−
10−instance allowPartials :: Partial
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/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−12
@@ -1,12 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff.Console
4−
5−class Partial where
6−
7−data List a = Nil | Cons a (List a)
8−
9−head :: (Partial) => List Int -> Int
10−head (Cons x _) = x
11−
12−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/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/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/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−11
@@ -1,11 +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− 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/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/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/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/TypedBinders.pursdeleted−62
@@ -1,62 +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−main = do
58− let t1 = test
59− t2 = test2 id
60− t3 = test3 1
61− t4 = test4 (Tuple 1 0)
62− 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/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/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−114
@@ -1,114 +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−
18−module Main where
19−
20−import Control.Monad (unless)
21−
22−import Data.List (intercalate,nub,sort)
23−import Data.Foldable (for_)
24−import Data.Version (showVersion)
25−
26−import Options.Applicative
27−import System.Directory (createDirectoryIfMissing)
28−import System.FilePath ((</>))
29−import System.FilePath.Glob (glob)
30−import System.Exit (exitFailure, exitSuccess)
31−import System.IO (hPutStr, stderr)
32−
33−import qualified Language.PureScript as P
34−import qualified Paths_purescript as Paths
35−
36−data HierarchyOptions = HierarchyOptions
37− { hierachyInput :: FilePath
38− , hierarchyOutput :: Maybe FilePath
39− }
40−
41−newtype SuperMap = SuperMap { unSuperMap :: Either P.ProperName (P.ProperName, P.ProperName) }
42− deriving Eq
43−
44−instance Show SuperMap where
45− show (SuperMap (Left sub)) = show sub
46− show (SuperMap (Right (super, sub))) = show super ++ " -> " ++ show sub
47−
48−instance Ord SuperMap where
49− compare (SuperMap s) (SuperMap s') = getCls s `compare` getCls s'
50− where
51− getCls = either id snd
52−
53−runModuleName :: P.ModuleName -> String
54−runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
55−
56−readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])
57−readInput paths = do
58− content <- mapM (\path -> (path, ) <$> readFile path) paths
59− return $ map snd <$> P.parseModulesFromFiles id content
60−
61−compile :: HierarchyOptions -> IO ()
62−compile (HierarchyOptions inputGlob mOutput) = do
63− input <- glob inputGlob
64− modules <- readInput input
65− case modules of
66− Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure
67− Right ms -> do
68− for_ ms $ \(P.Module _ _ moduleName decls _) ->
69− let name = runModuleName moduleName
70− tcs = filter P.isTypeClassDeclaration decls
71− supers = sort . nub . filter (not . null) $ fmap superClasses tcs
72− prologue = "digraph " ++ name ++ " {\n"
73− body = intercalate "\n" (concatMap (fmap (\s -> " " ++ show s ++ ";")) supers)
74− epilogue = "\n}"
75− hier = prologue ++ body ++ epilogue
76− in unless (null supers) $ case mOutput of
77− Just output -> do
78− createDirectoryIfMissing True output
79− writeFile (output </> name) hier
80− Nothing -> putStrLn hier
81− exitSuccess
82−
83−superClasses :: P.Declaration -> [SuperMap]
84−superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =
85− fmap (\(P.Qualified _ super, _) -> SuperMap (Right (super, sub))) supers
86−superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]
87−superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl
88−superClasses _ = []
89−
90−inputFile :: Parser FilePath
91−inputFile = strArgument $
92− metavar "FILE"
93− <> value "main.purs"
94− <> showDefault
95− <> help "The input file to generate a hierarchy from"
96−
97−outputFile :: Parser (Maybe FilePath)
98−outputFile = optional . strOption $
99− short 'o'
100− <> long "output"
101− <> help "The output directory"
102−
103−pscOptions :: Parser HierarchyOptions
104−pscOptions = HierarchyOptions <$> inputFile
105− <*> outputFile
106−
107−main :: IO ()
108−main = execParser opts >>= compile
109− where
110− opts = info (helper <*> pscOptions) infoModList
111− infoModList = fullDesc <> headerInfo <> footerInfo
112− headerInfo = header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"
113− footerInfo = footer $ "hierarchy " ++ showVersion Paths.version
114−
license-generator/generatedeleted−47
@@ -1,47 +0,0 @@
1−#!/bin/bash
2−# Generates the LICENSE file and prints it to standard output.
3−# Example use:
4−#
5−# ./license/generate > LICENSE
6−#
7−
8−set -e # exit on error
9−set -u # exit on undefined variable
10−set -o pipefail # propagate nonzero exit codes through pipelines
11−
12−export LC_CTYPE=C
13−export LANG=C
14−
15−if ! which cabal-dependency-licenses >/dev/null; then
16− echo "$0: the program 'cabal-dependency-licenses' is required." >&2
17− echo "$0: see Hackage: https://hackage.haskell.org/package/cabal-dependency-licenses" >&2
18− exit 1
19−fi
20−
21−echo_header() {
22− cat license-generator/header.txt
23−}
24−
25−echo_deps_names() {
26− cabal-dependency-licenses \
27− | grep '^- ' | sed 's/^..//' | gsort -h
28−}
29−
30−echo_deps_licenses() {
31− while read dep; do
32− echo "fetching LICENSE for: ${dep}" >&2
33− echo "${dep} LICENSE file:"
34− echo ""
35− curl --silent "https://hackage.haskell.org/package/${dep}/src/LICENSE" \
36− | sed 's/^/ /g' # indent by 2 characters
37− echo ""
38− done
39−}
40−
41−echo_deps_names > license-generator/tmp/deps.txt
42−
43−echo_header
44−echo ""
45−sed <license-generator/tmp/deps.txt 's/^/ /'
46−echo ""
47−echo_deps_licenses <license-generator/tmp/deps.txt
license-generator/header.txtdeleted−23
@@ -1,23 +0,0 @@
1−The MIT License (MIT)
2−
3−Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other
4−contributors
5−
6−Permission is hereby granted, free of charge, to any person obtaining a copy of
7−this software and associated documentation files (the "Software"), to deal in
8−the Software without restriction, including without limitation the rights to
9−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
10−the Software, and to permit persons to whom the Software is furnished to do so,
11−subject to the following conditions:
12−
13−The above copyright notice and this permission notice shall be included in all
14−copies or substantial portions of the Software.
15−
16−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
18−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
19−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
20−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
21−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22−
23−PureScript uses the following Haskell library packages. Their license files follow.
license-generator/tmp/.gitkeepdeleted

No changes to the content.

logo.pngdeleted

Binary file not shown.

package.yamlnew file+86
@@ -0,0 +1,86 @@
1+name: psgo
2+version: 0.1.0.0
3+github: "andyarvanitis/purescript-native"
4+license: BSD3
5+author: "Andy Arvanitis"
6+maintainer: "example@example.com"
7+copyright: "2018 Andy Arvanitis"
8+
9+extra-source-files:
10+- README.md
11+- ChangeLog.md
12+- stack.yaml
13+- support/*
14+
15+# Metadata used when publishing your package
16+# synopsis: Short description of your package
17+# category: Web
18+
19+# To avoid duplicated efforts in documentation and dealing with the
20+# complications of embedding Haddock markup inside cabal files, it is
21+# common to point users to the README.md file.
22+description: Please see the README on Github at <https://github.com/andyarvanitis/purescript-native#readme>
23+
24+dependencies:
25+- base >= 4.7 && < 5
26+- bytestring >= 0.10.8.2 && < 0.11
27+- purescript
28+- base-compat >=0.6.0
29+- protolude >=0.1.6
30+- text
31+- containers
32+- filepath
33+- monad-parallel >= 0.7.2.2 && <0.8
34+- pattern-arrows >=0.0.2 && <0.1
35+- safe >=0.3.9 && <0.4
36+- transformers >=0.3.0 && <0.6
37+- mtl >=2.1.0 && <2.3.0
38+- aeson >=1.0 && <1.5
39+- directory
40+- process
41+- file-embed
42+- filemanip
43+- gitrev
44+
45+library:
46+ source-dirs: src
47+ default-extensions:
48+ - ConstraintKinds
49+ - DataKinds
50+ - DeriveFunctor
51+ - EmptyDataDecls
52+ - FlexibleContexts
53+ - KindSignatures
54+ - LambdaCase
55+ - MultiParamTypeClasses
56+ - NoImplicitPrelude
57+ - PatternGuards
58+ - PatternSynonyms
59+ - RankNTypes
60+ - RecordWildCards
61+ - OverloadedStrings
62+ - ScopedTypeVariables
63+ - TupleSections
64+ - ViewPatterns
65+
66+executables:
67+ psgo:
68+ main: Main.hs
69+ source-dirs: app
70+ ghc-options:
71+ - -threaded
72+ - -rtsopts
73+ - -with-rtsopts=-N
74+ dependencies:
75+ - psgo
76+
77+tests:
78+ psgo-test:
79+ main: Spec.hs
80+ source-dirs: test
81+ ghc-options:
82+ - -threaded
83+ - -rtsopts
84+ - -with-rtsopts=-N
85+ dependencies:
86+ - psgo
pcc/Main.hsdeleted−174
@@ -1,174 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
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.Version (showVersion)
28−import qualified Data.Map as M
29−
30−import Options.Applicative as Opts
31−
32−import System.Exit (exitSuccess, exitFailure)
33−import System.IO (hPutStrLn, stderr)
34−import System.IO.UTF8
35−
36−import qualified Language.PureScript as P
37−import qualified Paths_purescript as Paths
38−
39−import Make
40−
41−data PCCOptions = PCCOptions
42− { pccmInput :: [FilePath]
43− , pccmForeignInput :: [FilePath]
44− , pccmOutputDir :: FilePath
45− , pccmOpts :: P.Options
46− , pccmUsePrefix :: Bool
47− }
48−
49−data InputOptions = InputOptions
50− { ioInputFiles :: [FilePath]
51− }
52−
53−compile :: PCCOptions -> IO ()
54−compile (PCCOptions input _ outputDir opts usePrefix) = do
55− moduleFiles <- readInput (InputOptions input)
56− case runWriterT (parseInputs moduleFiles []) of
57− Left errs -> do
58− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
59− exitFailure
60− Right ((ms, _), warnings) -> do
61− when (P.nonEmpty warnings) $
62− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
63− let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
64− makeActions = buildMakeActions outputDir filePathMap usePrefix
65− e <- runMake opts $ P.make makeActions (map snd ms)
66− case e of
67− Left errs -> do
68− putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
69− exitFailure
70− Right (_, warnings') -> do
71− when (P.nonEmpty warnings') $
72− putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
73− exitSuccess
74−
75−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
76−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
77−
78−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
79− => [(Either P.RebuildPolicy FilePath, String)]
80− -> [(FilePath, P.ForeignJS)]
81− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
82−parseInputs modules foreigns =
83− (,) <$> P.parseModulesFromFiles (either (const "") id) modules
84− <*> P.parseForeignModulesFromFiles foreigns
85−
86−inputFile :: Parser FilePath
87−inputFile = strArgument $
88− metavar "FILE"
89− <> help "The input .purs file(s)"
90−
91−inputForeignFile :: Parser FilePath
92−inputForeignFile = strOption $
93− short 'f'
94− <> long "ffi"
95− <> help "The input .js file(s) providing foreign import implementations"
96−
97−outputDirectory :: Parser FilePath
98−outputDirectory = strOption $
99− short 'o'
100− <> long "output"
101− <> Opts.value "output"
102− <> showDefault
103− <> help "The output directory"
104−
105−requirePath :: Parser (Maybe FilePath)
106−requirePath = optional $ strOption $
107− short 'r'
108− <> long "require-path"
109− <> help "The path prefix to use for require() calls in the generated code"
110−
111−noTco :: Parser Bool
112−noTco = switch $
113− long "no-tco"
114− <> help "Disable tail call optimizations"
115−
116−noPrelude :: Parser Bool
117−noPrelude = switch $
118− long "no-prelude"
119− <> help "Omit the automatic Prelude import"
120−
121−noMagicDo :: Parser Bool
122−noMagicDo = switch $
123− long "no-magic-do"
124− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
125−
126−noOpts :: Parser Bool
127−noOpts = switch $
128− long "no-opts"
129− <> help "Skip the optimization phase."
130−
131−comments :: Parser Bool
132−comments = switch $
133− short 'c'
134− <> long "comments"
135− <> help "Include comments in the generated code."
136−
137−verboseErrors :: Parser Bool
138−verboseErrors = switch $
139− short 'v'
140− <> long "verbose-errors"
141− <> help "Display verbose error messages"
142−
143−noPrefix :: Parser Bool
144−noPrefix = switch $
145− short 'p'
146− <> long "no-prefix"
147− <> help "Do not include comment header"
148−
149−options :: Parser P.Options
150−options = P.Options <$> noTco
151− <*> noMagicDo
152− <*> pure Nothing
153− <*> noOpts
154− <*> verboseErrors
155− <*> (not <$> comments)
156− <*> requirePath
157−
158−pccOptions :: Parser PCCOptions
159−pccOptions = PCCOptions <$> many inputFile
160− <*> many inputForeignFile
161− <*> outputDirectory
162− <*> options
163− <*> (not <$> noPrefix)
164−
165−main :: IO ()
166−main = execParser opts >>= compile
167− where
168− opts = info (version <*> helper <*> pccOptions) infoModList
169− infoModList = fullDesc <> headerInfo <> footerInfo
170− headerInfo = header "pcc - Compiles PureScript to C++11"
171− footerInfo = footer $ "pcc " ++ showVersion Paths.version
172−
173− version :: Parser (a -> a)
174− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
pcc/Make.hsdeleted−193
@@ -1,193 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Make
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DataKinds #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18−{-# LANGUAGE TupleSections #-}
19−{-# LANGUAGE TemplateHaskell #-}
20−
21−module Make
22− ( Make(..)
23− , runMake
24− , buildMakeActions
25− ) where
26−
27−import Control.Monad
28−import Control.Monad.Error.Class (MonadError(..))
29−import Control.Monad.Reader
30−
31−import Data.FileEmbed (embedFile)
32−import Data.List (intercalate)
33−import Data.Maybe (fromMaybe)
34−import Data.String (fromString)
35−import Data.Time.Clock
36−import Data.Version (showVersion)
37−import qualified Data.Map as M
38−import qualified Data.ByteString.Lazy as BL
39−import qualified Data.ByteString.Char8 as B
40−
41−import System.Directory (doesDirectoryExist, doesFileExist, getModificationTime, createDirectoryIfMissing)
42−import System.FilePath ((</>), takeDirectory, addExtension, dropExtension)
43−import System.IO.Error (tryIOError)
44−import System.IO.UTF8
45−
46−import Language.PureScript.Errors
47−import Language.PureScript (Make, runMake)
48−
49−import qualified Language.PureScript as P
50−import qualified Language.PureScript.CodeGen.Cpp as CPP
51−import qualified Language.PureScript.CoreFn as CF
52−import qualified Paths_purescript as Paths
53−
54−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
55−makeIO f io = do
56− e <- liftIO $ tryIOError io
57− either (throwError . P.singleError . f) return e
58−
59−-- Traverse (Either e) instance (base 4.7)
60−traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
61−traverseEither _ (Left x) = pure (Left x)
62−traverseEither f (Right y) = Right <$> f y
63−
64−buildMakeActions :: FilePath
65− -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
66− -> Bool
67− -> P.MakeActions Make
68−buildMakeActions outputDir filePathMap usePrefix =
69− P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
70− where
71−
72− getInputFile :: P.ModuleName -> FilePath
73− getInputFile mn =
74− let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap in
75− case path of
76− Right path' -> path'
77− Left _ -> error "Module has no filename in 'make'"
78−
79− getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
80− getInputTimestamp mn = do
81− let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
82− traverseEither getTimestamp path
83−
84− getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
85− getOutputTimestamp mn = do
86−
87− let filePath = dotsTo '/' $ P.runModuleName mn
88− fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)
89− srcFile = addExtension fileBase "cc"
90−-- headerFile = addExtension fileBase "hh"
91− externsFile = outputDir </> filePath </> "externs.purs"
92− min <$> getTimestamp srcFile <*> getTimestamp externsFile
93−
94− readExterns :: P.ModuleName -> Make (FilePath, BL.ByteString)
95− readExterns mn = do
96− let path = outputDir </> (dotsTo '/' $ P.runModuleName mn) </> "externs.purs"
97− (path, ) <$> readTextFile' path
98−
99− codegen :: CF.Module CF.Ann -> P.Environment -> P.Externs -> P.SupplyT Make ()
100− codegen m env exts = do
101− let mn = CF.moduleName m
102− let filePath = dotsTo '/' $ P.runModuleName mn
103− fileBase = outputDir </> filePath </> (last . words . dotsTo ' ' $ P.runModuleName mn)
104− srcFile = addExtension fileBase "cc"
105− headerFile = addExtension fileBase "hh"
106− externsFile = outputDir </> filePath </> "externs.purs"
107− prefix = ["Generated by pcc version " ++ showVersion Paths.version | usePrefix]
108− cpps <- CPP.moduleToCpp env m
109− let (hdrs,srcs) = span (/= CPP.CppEndOfHeader) cpps
110− psrcs <- CPP.prettyPrintCpp <$> pure srcs
111− phdrs <- CPP.prettyPrintCpp <$> pure hdrs
112− let src = unlines $ map ("// " ++) prefix ++ [psrcs]
113− hdr = unlines $ map ("// " ++) prefix ++ [phdrs]
114−
115− lift $ do
116− writeTextFile srcFile src
117− writeTextFile headerFile hdr
118− writeTextFile externsFile $ B.unpack $ BL.toStrict exts
119−
120− let supportDir = outputDir </> "PureScript"
121− supportFilesExist <- dirExists supportDir
122− when (not supportFilesExist) $ do
123− writeTextFile (outputDir </> "CMakeLists.txt") (fromString cmakeListsTxt)
124− writeTextFile (supportDir </> "PureScript.hh") $ B.unpack $(embedFile "pcc/include/purescript.hh")
125− writeTextFile (supportDir </> "PureScript.cc") $ B.unpack $(embedFile "pcc/include/purescript.cc")
126− writeTextFile (supportDir </> "map_key.hh") $ B.unpack $(embedFile "pcc/include/map_key.hh")
127− writeTextFile (supportDir </> "hash.hh") $ B.unpack $(embedFile "pcc/include/hash.hh")
128−
129− let inputPath = dropExtension $ getInputFile mn
130− hfile = addExtension inputPath "hh"
131− sfile = addExtension inputPath "cc"
132− hfileExists <- textFileExists hfile
133− when (hfileExists || requiresForeign m) $ do
134− text <- if hfileExists
135− then readTextFile hfile
136− else pure []
137− writeTextFile (addExtension (fileBase ++ "_ffi") "hh") text
138− sfileExists <- textFileExists sfile
139− when (sfileExists) $ do
140− text' <- readTextFile sfile
141− writeTextFile (addExtension (fileBase ++ "_ffi") "cc") text'
142−
143− requiresForeign :: CF.Module a -> Bool
144− requiresForeign = not . null . CF.moduleForeign
145−
146− dirExists :: FilePath -> Make Bool
147− dirExists path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ do
148− doesDirectoryExist path
149−
150− textFileExists :: FilePath -> Make Bool
151− textFileExists path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ do
152− doesFileExist path
153−
154− getTimestamp :: FilePath -> Make (Maybe UTCTime)
155− getTimestamp path = makeIO (const (ErrorMessage [] $ CannotGetFileInfo path)) $ do
156− exists <- doesFileExist path
157− traverse (const $ getModificationTime path) $ guard exists
158−
159− readTextFile :: FilePath -> Make String
160− readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path
161−
162− readTextFile' :: FilePath -> Make BL.ByteString
163− readTextFile' path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ BL.readFile path
164−
165− writeTextFile :: FilePath -> String -> Make ()
166− writeTextFile path text = makeIO (const (ErrorMessage [] $ CannotWriteFile path)) $ do
167− mkdirp path
168− writeFile path text
169− where
170− mkdirp :: FilePath -> IO ()
171− mkdirp = createDirectoryIfMissing True . takeDirectory
172−
173− -- | Render a progress message
174− renderProgressMessage :: P.ProgressMessage -> String
175− renderProgressMessage (P.CompilingModule mn) = "Compiling " ++ P.runModuleName mn
176−
177− progress :: P.ProgressMessage -> Make ()
178− progress = liftIO . putStrLn . renderProgressMessage
179−
180−dotsTo :: Char -> String -> String
181−dotsTo chr = map (\c -> if c == '.' then chr else c)
182−
183−-- TODO: quick and dirty for now -- explicit file list would be better
184−cmakeListsTxt :: String
185−cmakeListsTxt = intercalate "\n" lines'
186− where lines' = [ "cmake_minimum_required (VERSION 3.0)"
187− , "project (Main)"
188− , "file (GLOB_RECURSE SRCS *.cc)"
189− , "file (GLOB_RECURSE HDRS *.hh)"
190− , "add_executable (Main ${SRCS} ${HDRS})"
191− , "include_directories (${CMAKE_CURRENT_SOURCE_DIR})"
192− , "set (CMAKE_CXX_FLAGS ${CMAKE_CXX_FLAGS} \"-std=c++11 -DDEBUG\")"
193− ]
pcc/Makefile.exampledeleted−16
@@ -1,16 +0,0 @@
1−PCC := "../.cabal-sandbox/bin/pcc"
2−
3−MODULE_DIR="../../packages"
4−#MODULE_DIR="bower_components"
5−SOURCE_DIR="src"
6−
7−MODULES := $(shell find $(MODULE_DIR) -name '*.purs' | grep -v \/test\/ | grep -v \/example\/ | grep -v \/examples\/)
8−SOURCES := $(shell find $(SOURCE_DIR) -name '*.purs')
9−
10−all: main
11−
12−main:
13− $(PCC) $(MODULES) $(SOURCES)
14−
15−clean:
16− @rm -rf output/*
pcc/TestMain.hsdeleted−140
@@ -1,140 +0,0 @@
1−-------------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) 2015 Andy Arvanitis and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−--
12−--
13−-------------------------------------------------------------------------------
14−module Main where
15−
16−import Data.List
17−import Control.Applicative
18−import Control.Monad
19−
20−import System.Process
21−import System.FilePath
22−import System.Directory
23−
24−-------------------------------------------------------------------------------
25−testsDir :: IO (FilePath, FilePath)
26−-------------------------------------------------------------------------------
27−testsDir = do
28− baseDir <- getCurrentDirectory
29− return (baseDir </> "pcc-tests", baseDir)
30−
31−-------------------------------------------------------------------------------
32−main :: IO ()
33−-------------------------------------------------------------------------------
34−main = do
35−
36− (outputDir, baseDir) <- testsDir
37−
38− outputDirExists <- doesDirectoryExist outputDir
39− when outputDirExists $ removeDirectoryRecursive outputDir
40− createDirectory outputDir
41−
42− fetchPackages
43−
44− let srcDir = outputDir </> "src"
45− createDirectory srcDir
46−
47− let buildDir = outputDir </> "build"
48− createDirectory buildDir
49−
50− let makefile = outputDir </> "Makefile"
51− writeFile makefile makefileText
52−
53− let passingDir = baseDir </> "examples" </> "passing"
54− passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passingDir
55−
56− let tests = filter (`notElem` skipped) passingTestCases
57−
58− -- Run the tests
59− --
60− forM_ tests $ \inputFile -> do
61− --
62− -- Compile PureScript file
63− --
64− putStrLn $ "Compiling test " ++ inputFile ++ " ..."
65− setCurrentDirectory outputDir
66− copyFile (passingDir </> inputFile) (srcDir </> inputFile)
67− callProcess "make" ["clean", "main"]
68− --
69− -- Build and run C++ files
70− --
71− setCurrentDirectory buildDir
72− callProcess "cmake" ["../output"]
73− callProcess "make" []
74− callProcess (buildDir </> "Main") []
75−
76− removeFile (srcDir </> inputFile)
77−
78− -- TODO: support failing test cases
79− --
80− -- let failing = baseDir </> "examples" </> "failing"
81− -- failingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents failing
82− --
83−
84− setCurrentDirectory baseDir
85− putStrLn "pcc-tests finished"
86− putStrLn $ "Total tests available: " ++ show (length passingTestCases)
87− putStrLn $ "Tests run: " ++ show (length tests)
88− putStrLn $ "Tests skipped: " ++ show (length skipped)
89−
90−-------------------------------------------------------------------------------
91−repo :: String
92−-------------------------------------------------------------------------------
93−repo = "git://github.com/pure11/"
94−
95−-------------------------------------------------------------------------------
96−packages :: [(String, String)]
97−-------------------------------------------------------------------------------
98−packages =
99− [ ("purescript-eff", "")
100− , ("purescript-prelude", "")
101− , ("purescript-assert", "")
102− , ("purescript-st", "")
103− , ("purescript-console", "")
104− , ("purescript-functions", "")
105− ]
106−
107−-------------------------------------------------------------------------------
108−fetchPackages :: IO ()
109−-------------------------------------------------------------------------------
110−fetchPackages = do
111− (outputDir, baseDir) <- testsDir
112− let packageDir = outputDir </> "packages"
113− createDirectory packageDir
114− setCurrentDirectory packageDir
115− forM_ packages $ \package -> let branch = snd package in
116− callProcess "git" $ ["clone"] ++ (if null branch then [] else ["--branch", branch]) ++ [repo ++ (fst package) ++ ".git"]
117− setCurrentDirectory baseDir
118−
119−-------------------------------------------------------------------------------
120−makefileText :: String
121−-------------------------------------------------------------------------------
122−makefileText = intercalate "\n" lines'
123− where lines' = [ "PCC := '../.cabal-sandbox/bin/pcc'"
124− , "MODULE_DIR='packages'"
125− , "SOURCE_DIR='src'"
126− , "MODULES := $(shell find $(MODULE_DIR) -name '*.purs' | grep -v \\/test\\/ | grep -v \\/example\\/ | grep -v \\/examples\\/)"
127− , "SOURCES := $(shell find $(SOURCE_DIR) -name '*.purs')"
128− , "all: main"
129− , "main:"
130− , "\t$(PCC) $(MODULES) $(SOURCES)"
131− , "clean:"
132− , "\t@rm -rf output/*"
133− ]
134−
135−-------------------------------------------------------------------------------
136−skipped :: [String]
137−-------------------------------------------------------------------------------
138−skipped =
139− [ "ExplicitImportReExport.purs" -- OK, test has no main (would pass otherwise)
140− ]
pcc/include/hash.hhdeleted−42
@@ -1,42 +0,0 @@
1−///////////////////////////////////////////////////////////////////////////////
2−//
3−// Module : hash.hh
4−// Copyright : (c) Andy Arvanitis 2015
5−// License : MIT
6−//
7−// Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−// Stability : experimental
9−// Portability :
10−//
11−// Provides compile-time hashes for string literals.
12−//
13−///////////////////////////////////////////////////////////////////////////////
14−//
15−#ifndef PS_Hash_HH
16−#define PS_Hash_HH
17−
18−#include <cstdint>
19−
20−namespace PureScript {
21−
22− // Hash function which uses an xor version of the djb2 algorithm
23− //
24− constexpr auto djb2(const char s[], const uint32_t hash = 5381) -> uint32_t {
25− return !s[0] ? hash : djb2(s + 1, 33 * hash ^ s[0]);
26− }
27−
28− // Compile-time string literal hash
29− //
30− template <uint32_t H>
31− struct _compile_time_hash_ {
32− static constexpr long value = H;
33− };
34−
35− template <uint32_t H>
36− constexpr long _compile_time_hash_<H>::value;
37−
38− #define HASH(s) _compile_time_hash_<djb2(s)>::value
39−
40−} // namespace PureScript
41−
42−#endif // PS_Hash_HH
pcc/include/map_key.hhdeleted−57
@@ -1,57 +0,0 @@
1−///////////////////////////////////////////////////////////////////////////////
2−//
3−// Module : map_key.hh
4−// Copyright : (c) Andy Arvanitis 2015
5−// License : MIT
6−//
7−// Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−// Stability : experimental
9−// Portability :
10−//
11−// Support for maps using keys with compile-time hashes.
12−//
13−///////////////////////////////////////////////////////////////////////////////
14−//
15−#ifndef PS_MapKey_HH
16−#define PS_MapKey_HH
17−
18−#include "hash.hh"
19−
20−namespace PureScript {
21−
22− struct map_key_t {
23−
24− const uint32_t hash;
25−
26− explicit constexpr map_key_t(const uint32_t hash) : hash(hash) {}
27−
28− class hasher {
29− public:
30− constexpr auto operator() (const map_key_t key) const -> size_t {
31− return key.hash;
32− }
33− };
34−
35− class equal {
36− public:
37− constexpr auto operator() (const map_key_t key1, const map_key_t key2) const -> bool {
38− return key1.hash == key2.hash;
39− }
40− };
41− };
42−
43− // Compile-time map keys (from strings)
44− //
45− template <uint32_t H>
46− struct _compile_time_key_ {
47− static constexpr map_key_t value = map_key_t(H);
48− };
49−
50− template <uint32_t H>
51− constexpr map_key_t _compile_time_key_<H>::value;
52−
53− #define KEY(s) _compile_time_key_<djb2(s)>::value
54−
55−} // namespace PureScript
56−
57−#endif // PS_MapKey_HH
pcc/include/purescript.ccdeleted−536
@@ -1,536 +0,0 @@
1−///////////////////////////////////////////////////////////////////////////////
2−//
3−// Module : purescript.cc
4−// Copyright : (c) Andy Arvanitis 2015
5−// License : MIT
6−//
7−// Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−// Stability : experimental
9−// Portability :
10−//
11−// Basic types and functions to support purescript-to-C++1x rendering
12−//
13−///////////////////////////////////////////////////////////////////////////////
14−//
15−#include "PureScript.hh"
16−
17−namespace PureScript {
18−
19−any::any(const any& val) : type(val.type) {
20− switch (type) {
21− case Type::Integer: i = val.i; break;
22− case Type::Double: d = val.d; break;
23− case Type::Character: c = val.c; break;
24− case Type::Boolean: b = val.b; break;
25− case Type::String: new (&s) shared_string (val.s); break;
26− case Type::Map: new (&m) shared_map (val.m); break;
27− case Type::Vector: new (&v) shared_vector (val.v); break;
28− case Type::Function: new (&f) shared_fn (val.f); break;
29− case Type::EffFunction: new (&e) shared_eff_fn (val.e); break;
30− case Type::Thunk: new (&t) shared_thunk (val.t); break;
31− case Type::Pointer: new (&p) shared_void_ptr (val.p); break;
32−
33− default: assert(false && "Unsupported type in copy ctor");
34− }
35−}
36−
37−void any::swap(any&& val) {
38− type = val.type;
39− switch (type) {
40− case Type::Integer: i = val.i; break;
41− case Type::Double: d = val.d; break;
42− case Type::Character: c = val.c; break;
43− case Type::Boolean: b = val.b; break;
44− case Type::String: new (&s) shared_string (std::move(val.s)); break;
45− case Type::Map: new (&m) shared_map (std::move(val.m)); break;
46− case Type::Vector: new (&v) shared_vector (std::move(val.v)); break;
47− case Type::Function: new (&f) shared_fn (std::move(val.f)); break;
48− case Type::EffFunction: new (&e) shared_eff_fn (std::move(val.e)); break;
49− case Type::Thunk: new (&t) shared_thunk (std::move(val.t)); break;
50− case Type::Pointer: new (&p) shared_void_ptr (std::move(val.p)); break;
51−
52− default: assert(false && "Unsupported type in move ctor");
53− }
54−}
55−
56−any::~any() {
57− // std::cout << "destroy" << std::endl;
58− switch (type) {
59− case Type::Integer: ; break;
60− case Type::Double: ; break;
61− case Type::Character: ; break;
62− case Type::Boolean: ; break;
63− case Type::String: s.~shared_string(); break;
64− case Type::Map: m.~shared_map(); break;
65− case Type::Vector: v.~shared_vector(); break;
66− case Type::Function: f.~shared_fn(); break;
67− case Type::EffFunction: e.~shared_eff_fn(); break;
68− case Type::Thunk: t.~shared_thunk(); break;
69− case Type::Pointer: p.~shared_void_ptr(); break;
70−
71− default: assert(false && "Unsupported type in destructor");
72− }
73−};
74−
75− #define RETURN_VALUE(TYPE, VAL, FN) \
76− if (type == TYPE) { \
77− return FN(VAL); \
78− } \
79− const any* valuePtr = this; \
80− do { \
81− assert(valuePtr->type == Type::Thunk); \
82− const any& value = (*valuePtr->t)(unthunk); \
83− if (value.type == TYPE) { \
84− return FN(value.VAL); \
85− } \
86− valuePtr = &value; \
87− } while (valuePtr->type != Type::Unknown); \
88− return FN(VAL);
89−
90− template <typename T>
91− auto any::cast() const -> typename std::enable_if<std::is_same<T, long>::value, T>::type {
92− RETURN_VALUE(Type::Integer, i,)
93− }
94− template auto any::cast<long>() const -> long;
95−
96− template <typename T>
97− auto any::cast() const -> typename std::enable_if<std::is_same<T, double>::value, T>::type {
98− RETURN_VALUE(Type::Double, d,)
99− }
100− template auto any::cast<double>() const -> double;
101−
102− template <typename T>
103− auto any::cast() const -> typename std::enable_if<std::is_same<T, char>::value, T>::type {
104− RETURN_VALUE(Type::Character, c,)
105− }
106− template auto any::cast<char>() const -> char;
107−
108− template <typename T>
109− auto any::cast() const -> typename std::enable_if<std::is_same<T, bool>::value, T>::type {
110− RETURN_VALUE(Type::Boolean, b,)
111− }
112− template auto any::cast<bool>() const -> bool;
113−
114− template <typename T>
115− auto any::cast() const -> typename std::enable_if<std::is_same<T, string>::value, const T&>::type {
116− RETURN_VALUE(Type::String, s, *)
117− }
118− template auto any::cast<string>() const -> const string&;
119−
120− template <typename T>
121− auto any::cast() const -> typename std::enable_if<std::is_same<T, const char*>::value, const T>::type {
122− RETURN_VALUE(Type::String, s->c_str(),)
123− }
124− template auto any::cast<const char*>() const -> const char* const;
125−
126− template <typename T>
127− auto any::cast() const -> typename std::enable_if<std::is_same<T, map>::value, const T&>::type {
128− RETURN_VALUE(Type::Map, m, *)
129− }
130− template auto any::cast<any::map>() const -> const map&;
131−
132− template <typename T>
133− auto any::cast() const -> typename std::enable_if<std::is_same<T, vector>::value, const T&>::type {
134− RETURN_VALUE(Type::Vector, v, *)
135− }
136− template auto any::cast<any::vector>() const -> const vector&;
137−
138−
139− auto any::operator()(const any arg) const -> any {
140− if (type == Type::Function) {
141− return (*f)(arg);
142− }
143− const any* valuePtr = this;
144− do {
145− assert(valuePtr->type == Type::Thunk);
146− const any& value = (*valuePtr->t)(unthunk);
147− if (value.type == Type::Function) {
148− return (*value.f)(arg);
149− }
150− valuePtr = &value;
151− } while (valuePtr->type != Type::Unknown);
152− return nullptr;
153− }
154−
155− auto any::operator()(const as_thunk) const -> const any& {
156− assert(type == Type::Thunk);
157− return (*t)(unthunk);
158− }
159−
160− auto any::call(const any& a) -> any {
161− assert(a.type == Type::EffFunction || a.type == Type::Function);
162− if (a.type == Type::EffFunction) {
163− return (*a.e)();
164− } else {
165− return (*a.f)(false);
166− }
167− }
168−
169− auto any::operator()() const -> any {
170− if (type == Type::EffFunction || type == Type::Function) {
171− return call(*this);
172− }
173− assert(type == Type::Thunk);
174− const any* valuePtr = this;
175− do {
176− const any& value = (*valuePtr->t)(unthunk);
177− if (value.type != Type::Thunk) {
178− return call(value);
179− }
180− valuePtr = &value;
181− } while (true);
182− }
183−
184− any::operator long() const {
185− RETURN_VALUE(Type::Integer, i,)
186− }
187−
188− any::operator double() const {
189− RETURN_VALUE(Type::Double, d,)
190− }
191−
192− any::operator bool() const {
193− RETURN_VALUE(Type::Boolean, b,)
194− }
195−
196− any::operator const string&() const {
197− RETURN_VALUE(Type::String, s, *)
198− }
199−
200− any::operator const map&() const {
201− RETURN_VALUE(Type::Map, m, *)
202− }
203−
204− any::operator const vector&() const {
205− RETURN_VALUE(Type::Vector, v, *)
206− }
207−
208− auto any::extractPointer() const -> const void* {
209− RETURN_VALUE(Type::Pointer, p.get(),)
210− }
211−
212− auto any::extract_value(const any& a) -> const any& {
213− if (a.type != Type::Thunk) {
214− return a;
215− }
216− const any* valuePtr = &a;
217− do {
218− const any& value = (*valuePtr->t)(unthunk);
219− if (value.type != Type::Thunk) {
220− return value;
221− }
222− valuePtr = &value;
223− } while (true);
224− }
225−
226− auto any::operator[](const map_key_t rhs) const -> const any& {
227− RETURN_VALUE(Type::Map, m->at(rhs),)
228− }
229−
230− auto any::operator[](const vector::size_type rhs) const -> const any& {
231− RETURN_VALUE(Type::Vector, v->at(rhs),)
232− }
233−
234− auto any::operator[](const any& rhs) const -> const any& {
235− RETURN_VALUE(Type::Vector, v->at(rhs.cast<long>()),)
236− }
237−
238−#define DEFINE_OPERATOR_LHS(K, T, OP, V, R, P) \
239−auto operator OP(const T lhs, const any& rhs_) -> R { \
240− auto& rhs = any::extract_value(rhs_); \
241− assert(rhs.type == any::Type::K); \
242− return lhs OP P(rhs.V); \
243−}
244−
245−#define DEFINE_OPERATOR_RHS(K, T, OP, V, R, P) \
246−auto any::operator OP(const T rhs) const -> R { \
247− auto& lhs = any::extract_value(*this); \
248− assert(lhs.type == Type::K); \
249− return P(lhs.V) OP rhs; \
250−}
251−
252−auto any::operator==(const any& rhs_) const -> bool {
253− auto& lhs = extract_value(*this);
254− auto& rhs = extract_value(rhs_);
255− assert(lhs.type == rhs.type);
256− switch (lhs.type) {
257− case Type::Integer: return lhs.i == rhs.i;
258− case Type::Double: return lhs.d == rhs.d;
259− case Type::Character: return lhs.c == rhs.c;
260− case Type::Boolean: return lhs.b == rhs.b;
261− case Type::String: return (*lhs.s) == (*rhs.s);
262− case Type::Pointer: return lhs.p == rhs.p;
263− default: assert(false && "Unsupported type for '==' operator");
264− }
265− return false;
266−}
267−
268−DEFINE_OPERATOR_RHS(Integer, long, ==, i, bool,)
269−DEFINE_OPERATOR_RHS(Double, double, ==, d, bool,)
270−DEFINE_OPERATOR_RHS(Character, char, ==, c, bool,)
271−DEFINE_OPERATOR_RHS(Boolean, bool, ==, b, bool,)
272−DEFINE_OPERATOR_RHS(String, string&, ==, s, bool, *)
273−DEFINE_OPERATOR_RHS(String, char* const, ==, s, bool, *)
274−
275−auto any::operator!=(const any& rhs_) const -> bool {
276− auto& lhs = extract_value(*this);
277− auto& rhs = extract_value(rhs_);
278− assert(lhs.type == rhs.type);
279− switch (lhs.type) {
280− case Type::Integer: return lhs.i != rhs.i;
281− case Type::Double: return lhs.d != rhs.d;
282− case Type::Character: return lhs.c != rhs.c;
283− case Type::Boolean: return lhs.b != rhs.b;
284− case Type::String: return (*lhs.s) != (*rhs.s);
285− case Type::Pointer: return lhs.p != rhs.p;
286− default: assert(false && "Unsupported type for '!=' operator");
287− }
288− return false;
289−}
290−
291−DEFINE_OPERATOR_RHS(Integer, long, !=, i, bool,)
292−DEFINE_OPERATOR_RHS(Double, double, !=, d, bool,)
293−DEFINE_OPERATOR_RHS(Character, char, !=, c, bool,)
294−DEFINE_OPERATOR_RHS(Boolean, bool, !=, b, bool,)
295−DEFINE_OPERATOR_RHS(String, string&, !=, s, bool, *)
296−DEFINE_OPERATOR_RHS(String, char* const, !=, s, bool, *)
297−
298−auto any::operator<(const any& rhs_) const -> bool {
299− auto& lhs = extract_value(*this);
300− auto& rhs = extract_value(rhs_);
301− assert(lhs.type == rhs.type);
302− switch (lhs.type) {
303− case Type::Integer: return lhs.i < rhs.i;
304− case Type::Double: return lhs.d < rhs.d;
305− case Type::Character: return lhs.c < rhs.c;
306− case Type::Boolean: return lhs.b < rhs.b;
307− case Type::String: return (*lhs.s) < (*rhs.s);
308− default: assert(false && "Unsupported type for '<' operator");
309− }
310− return false;
311−}
312−
313−DEFINE_OPERATOR_RHS(Integer, long, <, i, bool,)
314−DEFINE_OPERATOR_RHS(Double, double, <, d, bool,)
315−DEFINE_OPERATOR_RHS(Character, char, <, c, bool,)
316−DEFINE_OPERATOR_RHS(Boolean, bool, <, b, bool,)
317−DEFINE_OPERATOR_RHS(String, string&, <, s, bool, *)
318−DEFINE_OPERATOR_RHS(String, char* const, <, s, bool, *)
319−
320−auto any::operator<=(const any& rhs_) const -> bool {
321− auto& lhs = extract_value(*this);
322− auto& rhs = extract_value(rhs_);
323− assert(lhs.type == rhs.type);
324− switch (lhs.type) {
325− case Type::Integer: return lhs.i <= rhs.i;
326− case Type::Double: return lhs.d <= rhs.d;
327− case Type::Character: return lhs.c <= rhs.c;
328− case Type::Boolean: return lhs.b <= rhs.b;
329− case Type::String: return (*lhs.s) <= (*rhs.s);
330− default: assert(false && "Unsupported type for '<' operator");
331− }
332− return false;
333−}
334−
335−DEFINE_OPERATOR_RHS(Integer, long, <=, i, bool,)
336−DEFINE_OPERATOR_RHS(Double, double, <=, d, bool,)
337−DEFINE_OPERATOR_RHS(Character, char, <=, c, bool,)
338−DEFINE_OPERATOR_RHS(Boolean, bool, <=, b, bool,)
339−DEFINE_OPERATOR_RHS(String, string&, <=, s, bool, *)
340−DEFINE_OPERATOR_RHS(String, char* const, <=, s, bool, *)
341−
342−auto any::operator>(const any& rhs_) const -> bool {
343− auto& lhs = extract_value(*this);
344− auto& rhs = extract_value(rhs_);
345− assert(lhs.type == rhs.type);
346− switch (lhs.type) {
347− case Type::Integer: return lhs.i > rhs.i;
348− case Type::Double: return lhs.d > rhs.d;
349− case Type::Character: return lhs.c > rhs.c;
350− case Type::Boolean: return lhs.b > rhs.b;
351− case Type::String: return (*lhs.s) > (*rhs.s);
352− default: assert(false && "Unsupported type for '>' operator");
353− }
354− return false;
355−}
356−
357−DEFINE_OPERATOR_RHS(Integer, long, >, i, bool,)
358−DEFINE_OPERATOR_RHS(Double, double, >, d, bool,)
359−DEFINE_OPERATOR_RHS(Character, char, >, c, bool,)
360−DEFINE_OPERATOR_RHS(Boolean, bool, >, b, bool,)
361−DEFINE_OPERATOR_RHS(String, string&, >, s, bool, *)
362−DEFINE_OPERATOR_RHS(String, char* const, >, s, bool, *)
363−
364−auto any::operator>=(const any& rhs_) const -> bool {
365− auto& lhs = extract_value(*this);
366− auto& rhs = extract_value(rhs_);
367− assert(lhs.type == rhs.type);
368− switch (lhs.type) {
369− case Type::Integer: return lhs.i >= rhs.i;
370− case Type::Double: return lhs.d >= rhs.d;
371− case Type::Character: return lhs.c >= rhs.c;
372− case Type::Boolean: return lhs.b >= rhs.b;
373− case Type::String: return (*lhs.s) >= (*rhs.s);
374− default: assert(false && "Unsupported type for '>' operator");
375− }
376− return false;
377−}
378−
379−DEFINE_OPERATOR_RHS(Integer, long, >=, i, bool,)
380−DEFINE_OPERATOR_RHS(Double, double, >=, d, bool,)
381−DEFINE_OPERATOR_RHS(Character, char, >=, c, bool,)
382−DEFINE_OPERATOR_RHS(Boolean, bool, >=, b, bool,)
383−DEFINE_OPERATOR_RHS(String, string&, >=, s, bool, *)
384−DEFINE_OPERATOR_RHS(String, char* const, >=, s, bool, *)
385−
386−auto any::operator+(const any& rhs_) const -> any {
387− auto& lhs = extract_value(*this);
388− auto& rhs = extract_value(rhs_);
389− assert(lhs.type == rhs.type);
390− switch (lhs.type) {
391− case Type::Integer: return lhs.i + rhs.i;
392− case Type::Double: return lhs.d + rhs.d;
393− case Type::Character: return any(char(lhs.c + rhs.c));
394− case Type::String: return (*lhs.s) + (*rhs.s);
395− default: assert(false && "Unsupported type for '+' operator");
396− }
397− return nullptr;
398−}
399−
400−DEFINE_OPERATOR_RHS(Integer, long, +, i, long,)
401−DEFINE_OPERATOR_RHS(Double, double, +, d, double,)
402−DEFINE_OPERATOR_RHS(Character, char, +, c, char,)
403−DEFINE_OPERATOR_RHS(String, string&, +, s, string, *)
404−DEFINE_OPERATOR_RHS(String, char* const, +, s, string, *)
405−
406−auto any::operator-(const any& rhs_) const -> any {
407− auto& lhs = extract_value(*this);
408− auto& rhs = extract_value(rhs_);
409− assert(lhs.type == rhs.type);
410− switch (lhs.type) {
411− case Type::Integer: return lhs.i - rhs.i;
412− case Type::Double: return lhs.d - rhs.d;
413− case Type::Character: return any(char(lhs.c - rhs.c));
414− default: assert(false && "Unsupported type for '-' binary operator");
415− }
416− return nullptr;
417−}
418−
419−DEFINE_OPERATOR_RHS(Integer, long, -, i, long,)
420−DEFINE_OPERATOR_RHS(Double, double, -, d, double,)
421−DEFINE_OPERATOR_RHS(Character, char, -, c, char,)
422−
423−auto any::operator*(const any& rhs_) const -> any {
424− auto& lhs = extract_value(*this);
425− auto& rhs = extract_value(rhs_);
426− assert(lhs.type == rhs.type);
427− switch (lhs.type) {
428− case Type::Integer: return lhs.i * rhs.i;
429− case Type::Double: return lhs.d * rhs.d;
430− default: assert(false && "Unsupported type for '*' operator");
431− }
432− return nullptr;
433−}
434−
435−DEFINE_OPERATOR_RHS(Integer, long, *, i, long,)
436−DEFINE_OPERATOR_RHS(Double, double, *, d, double,)
437−
438−auto any::operator/(const any& rhs_) const -> any {
439− auto& lhs = extract_value(*this);
440− auto& rhs = extract_value(rhs_);
441− assert(lhs.type == rhs.type);
442− switch (lhs.type) {
443− case Type::Integer: return lhs.i / rhs.i;
444− case Type::Double: return lhs.d / rhs.d;
445− default: assert(false && "Unsupported type for '/' operator");
446− }
447− return nullptr;
448−}
449−
450−DEFINE_OPERATOR_RHS(Integer, long, /, i, long,)
451−DEFINE_OPERATOR_RHS(Double, double, /, d, double,)
452−
453−auto any::operator%(const any& rhs_) const -> any {
454− auto& lhs = extract_value(*this);
455− auto& rhs = extract_value(rhs_);
456− assert(lhs.type == rhs.type);
457− switch (lhs.type) {
458− case Type::Integer: return lhs.i % rhs.i;
459− default: assert(false && "Unsupported type for '%' operator");
460− }
461− return nullptr;
462−}
463−
464−DEFINE_OPERATOR_RHS(Integer, long, %, i, long,)
465−
466−auto any::operator-() const -> any {
467− auto& lhs = any::extract_value(*this);
468− switch (lhs.type) {
469− case Type::Integer: return (- lhs.i);
470− case Type::Double: return (- lhs.d);
471− default: assert(false && "Unsupported type for unary '-' operator");
472− }
473− return nullptr;
474−}
475−
476−DEFINE_OPERATOR_LHS(Integer, long, ==, i, bool,)
477−DEFINE_OPERATOR_LHS(Integer, long, !=, i, bool,)
478−DEFINE_OPERATOR_LHS(Integer, long, <, i, bool,)
479−DEFINE_OPERATOR_LHS(Integer, long, <=, i, bool,)
480−DEFINE_OPERATOR_LHS(Integer, long, >, i, bool,)
481−DEFINE_OPERATOR_LHS(Integer, long, >=, i, bool,)
482−
483−DEFINE_OPERATOR_LHS(Double, double, ==, d, bool,)
484−DEFINE_OPERATOR_LHS(Double, double, !=, d, bool,)
485−DEFINE_OPERATOR_LHS(Double, double, <, d, bool,)
486−DEFINE_OPERATOR_LHS(Double, double, <=, d, bool,)
487−DEFINE_OPERATOR_LHS(Double, double, >, d, bool,)
488−DEFINE_OPERATOR_LHS(Double, double, >=, d, bool,)
489−
490−DEFINE_OPERATOR_LHS(Character, char, ==, c, bool,)
491−DEFINE_OPERATOR_LHS(Character, char, !=, c, bool,)
492−DEFINE_OPERATOR_LHS(Character, char, <, c, bool,)
493−DEFINE_OPERATOR_LHS(Character, char, <=, c, bool,)
494−DEFINE_OPERATOR_LHS(Character, char, >, c, bool,)
495−DEFINE_OPERATOR_LHS(Character, char, >=, c, bool,)
496−
497−DEFINE_OPERATOR_LHS(Boolean, bool, ==, b, bool,)
498−DEFINE_OPERATOR_LHS(Boolean, bool, !=, b, bool,)
499−DEFINE_OPERATOR_LHS(Boolean, bool, <, b, bool,)
500−DEFINE_OPERATOR_LHS(Boolean, bool, <=, b, bool,)
501−DEFINE_OPERATOR_LHS(Boolean, bool, >, b, bool,)
502−DEFINE_OPERATOR_LHS(Boolean, bool, >=, b, bool,)
503−
504−DEFINE_OPERATOR_LHS(String, string&, ==, s, bool, *)
505−DEFINE_OPERATOR_LHS(String, string&, !=, s, bool, *)
506−DEFINE_OPERATOR_LHS(String, string&, <, s, bool, *)
507−DEFINE_OPERATOR_LHS(String, string&, <=, s, bool, *)
508−DEFINE_OPERATOR_LHS(String, string&, >, s, bool, *)
509−DEFINE_OPERATOR_LHS(String, string&, >=, s, bool, *)
510−
511−DEFINE_OPERATOR_LHS(String, char* const, ==, s, bool, *)
512−DEFINE_OPERATOR_LHS(String, char* const, !=, s, bool, *)
513−DEFINE_OPERATOR_LHS(String, char* const, <, s, bool, *)
514−DEFINE_OPERATOR_LHS(String, char* const, <=, s, bool, *)
515−DEFINE_OPERATOR_LHS(String, char* const, >, s, bool, *)
516−DEFINE_OPERATOR_LHS(String, char* const, >=, s, bool, *)
517−
518−DEFINE_OPERATOR_LHS(Integer, long, +, i, long,)
519−DEFINE_OPERATOR_LHS(Integer, long, -, i, long,)
520−DEFINE_OPERATOR_LHS(Integer, long, *, i, long,)
521−DEFINE_OPERATOR_LHS(Integer, long, /, i, long,)
522−DEFINE_OPERATOR_LHS(Integer, long, %, i, long,)
523−
524−DEFINE_OPERATOR_LHS(Double, double, +, d, double,)
525−DEFINE_OPERATOR_LHS(Double, double, -, d, double,)
526−DEFINE_OPERATOR_LHS(Double, double, *, d, double,)
527−DEFINE_OPERATOR_LHS(Double, double, /, d, double,)
528−
529−DEFINE_OPERATOR_LHS(Character, char, +, i, char,)
530−DEFINE_OPERATOR_LHS(Character, char, -, i, char,)
531−
532−DEFINE_OPERATOR_LHS(String, string&, +, s, string, *)
533−DEFINE_OPERATOR_LHS(String, char* const, +, s, string, *)
534−
535−
536−} // namespace PureScript
pcc/include/purescript.hhdeleted−403
@@ -1,403 +0,0 @@
1−///////////////////////////////////////////////////////////////////////////////
2−//
3−// Module : purescript.hh
4−// Copyright : (c) Andy Arvanitis 2015
5−// License : MIT
6−//
7−// Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−// Stability : experimental
9−// Portability :
10−//
11−// Basic types and functions to support purescript-to-C++1x rendering
12−//
13−///////////////////////////////////////////////////////////////////////////////
14−//
15−#ifndef PureScript_HH
16−#define PureScript_HH
17−
18−// Standard includes
19−
20−#if defined(DEBUG)
21− #include <cassert>
22−#else
23− #define NDEBUG
24− #undef assert
25− #define assert(x)
26−#endif
27−
28−#include <memory>
29−#include <functional>
30−#include <string>
31−#include <vector>
32−#include <unordered_map>
33−#include <stdexcept>
34−
35−#include "map_key.hh"
36−#include "hash.hh"
37−
38−namespace PureScript {
39−
40−using string = std::string;
41−using runtime_error = std::runtime_error;
42−using nullptr_t = std::nullptr_t;
43−
44−// A variant data class designed to provide some features of dynamic typing.
45−//
46−class any {
47−
48− public:
49− enum class Type : std::int8_t {
50− Unknown,
51− Integer,
52− Double,
53− Character,
54− Boolean,
55− String,
56− Map,
57− Vector,
58− Function,
59− EffFunction,
60− Thunk,
61− Pointer
62− };
63−
64− Type type = Type::Unknown;
65−
66− struct as_thunk {
67− };
68− static constexpr as_thunk unthunk = as_thunk{};
69−
70− using map = std::unordered_map<map_key_t, const any, map_key_t::hasher, map_key_t::equal>;
71− using vector = std::vector<any>;
72− using fn = std::function<any(const any&)>;
73− using eff_fn = std::function<any()>;
74− using thunk = std::function<const any& (const as_thunk)>;
75−
76− using shared_string = std::shared_ptr<string>;
77− using shared_map = std::shared_ptr<map>;
78− using shared_vector = std::shared_ptr<vector>;
79−
80− using shared_fn = std::shared_ptr<fn>;
81− using shared_eff_fn = std::shared_ptr<eff_fn>;
82− using shared_thunk = std::shared_ptr<thunk>;
83−
84− template <typename T>
85− using shared = std::shared_ptr<T>;
86−
87− using shared_void_ptr = std::shared_ptr<void>;
88−
89− template <typename T>
90− static constexpr auto make_shared(const T& arg) -> shared<T> {
91− return std::make_shared<T>(arg);
92− }
93−
94− template <typename T>
95− static constexpr auto make_shared(T&& arg) -> shared<T> {
96− return std::make_shared<T>(std::move(arg));
97− }
98−
99− template <typename T, typename U>
100− static constexpr auto static_cast_shared(U arg) -> T* {
101− return static_cast<T*>(arg.get());
102− }
103−
104− private:
105− union {
106− long i;
107− double d;
108− char c;
109− bool b;
110− shared_string s;
111− shared_map m;
112− shared_vector v;
113− shared_fn f;
114− shared_eff_fn e;
115− shared_thunk t;
116− shared_void_ptr p;
117− };
118−
119− public:
120−
121− any(const long val) : type(Type::Integer), i(val) {}
122− any(const int val) : type(Type::Integer), i(val) {}
123− any(const unsigned int val) : type(Type::Integer), i(val) {}
124−
125− any(const double val) : type(Type::Double), d(val) {}
126−
127− any(const char val) : type(Type::Character), c(val) {}
128−
129− any(const bool val) : type(Type::Boolean), b(val) {}
130−
131− any(const string& val) : type(Type::String), s(make_shared<string>(val)) {}
132− any(string&& val) : type(Type::String), s(make_shared<string>(std::move(val))) {}
133−
134− any(const char val[]) : type(Type::String), s(make_shared<string>(val)) {}
135−
136− any(const shared_string& val) : type(Type::String), s(val) {}
137− any(shared_string&& val) : type(Type::String), s(std::move(val)) {}
138−
139− any(const map& val) : type(Type::Map), m(make_shared<map>(val)) {}
140− any(map&& val) : type(Type::Map), m(make_shared<map>(std::move(val))) {}
141−
142− any(const shared_map& val) : type(Type::Map), m(val) {}
143− any(shared_map&& val) : type(Type::Map), m(std::move(val)) {}
144−
145− any(const vector& val) : type(Type::Vector), v(make_shared<vector>(val)) {}
146− any(vector&& val) : type(Type::Vector), v(make_shared<vector>(std::move(val))) {}
147−
148− any(const shared_vector& val) : type(Type::Vector), v(val) {}
149− any(shared_vector&& val) : type(Type::Vector), v(std::move(val)) {}
150−
151− any(const shared_fn& val) : type(Type::Function), f(val) {}
152− any(shared_fn&& val) : type(Type::Function), f(std::move(val)) {}
153−
154− template <typename T>
155− any(const T& val, typename std::enable_if<std::is_assignable<fn,T>::value>::type* = 0)
156− : type(Type::Function), f(make_shared<fn>(val)) {}
157−
158− // template <typename T>
159− // any(T&& val, typename std::enable_if<std::is_assignable<fn,T>::value>::type* = 0)
160− // : type(Type::Function), f(std::move(val)) {}
161−
162− any(const shared_eff_fn& val) : type(Type::EffFunction), e(val) {}
163− any(shared_eff_fn&& val) : type(Type::EffFunction), e(std::move(val)) {}
164−
165− template <typename T>
166− any(const T& val, typename std::enable_if<std::is_assignable<eff_fn,T>::value>::type* = 0)
167− : type(Type::EffFunction), e(make_shared<eff_fn>(val)) {}
168−
169− any(const shared_thunk& val) : type(Type::Thunk), t(val) {}
170− any(shared_thunk&& val) : type(Type::Thunk), t(std::move(val)) {}
171−
172− template <typename T>
173− any(const T& val, typename std::enable_if<std::is_assignable<thunk,T>::value>::type* = 0)
174− : type(Type::Thunk), t(make_shared<thunk>(val)) {}
175−
176− template <typename T>
177− any(const T& val, typename std::enable_if<std::is_assignable<shared_void_ptr,T>::value>::type* = 0)
178− : type(Type::Pointer), p(val) {}
179−
180− any(std::nullptr_t) : type(Type::Pointer), p(nullptr) {}
181−
182− template <typename T>
183− any(T&& val, typename std::enable_if<std::is_assignable<shared_void_ptr,T>::value>::type* = 0)
184− : type(Type::Pointer), p(std::move(val)) {}
185−
186− any(const any&);
187−
188− void swap(any&&);
189−
190− any(any&& val) {
191− swap(std::move(val));
192− }
193−
194− auto operator=(any val) -> any& {
195− swap(std::move(val));
196− return *this;
197− }
198−
199− any() = delete;
200− ~any();
201−
202− template <typename T>
203− auto cast() const -> typename std::enable_if<std::is_same<T, long>::value, T>::type;
204−
205− template <typename T>
206− auto cast() const -> typename std::enable_if<std::is_same<T, double>::value, T>::type;
207−
208− template <typename T>
209− auto cast() const -> typename std::enable_if<std::is_same<T, char>::value, T>::type;
210−
211− template <typename T>
212− auto cast() const -> typename std::enable_if<std::is_same<T, bool>::value, T>::type;
213−
214− template <typename T>
215− auto cast() const -> typename std::enable_if<std::is_same<T, string>::value, const T&>::type;
216−
217− template <typename T>
218− auto cast() const -> typename std::enable_if<std::is_same<T, const char*>::value, const T>::type;
219−
220− template <typename T>
221− auto cast() const -> typename std::enable_if<std::is_same<T, map>::value, const T&>::type;
222−
223− template <typename T>
224− auto cast() const -> typename std::enable_if<std::is_same<T, vector>::value, const T&>::type;
225−
226− template <typename T>
227− auto cast() const -> typename std::enable_if<std::is_assignable<shared_void_ptr,T>::value, typename T::element_type*>::type {
228− if (type == Type::Pointer) {
229− return static_cast_shared<typename T::element_type>(p);
230− }
231− const any* valuePtr = this;
232− do {
233− assert(valuePtr->type == Type::Thunk);
234− const any& value = (*valuePtr->t)(unthunk);
235− if (value.type == Type::Pointer) {
236− return static_cast_shared<typename T::element_type>(value.p);
237− }
238− valuePtr = &value;
239− } while (valuePtr->type != Type::Unknown);
240− return nullptr;
241− }
242−
243− auto operator()(const any) const -> any;
244−
245− auto operator()(const as_thunk) const -> const any&;
246−
247− auto operator()() const -> any;
248−
249− static auto call(const any& a) -> any;
250−
251− operator long() const;
252− operator double() const;
253− operator bool() const;
254−
255− operator const string&() const;
256− operator const map&() const;
257− operator const vector&() const;
258−
259− auto operator[](const map_key_t) const -> const any&;
260− auto operator[](const vector::size_type) const -> const any&;
261− auto operator[](const any&) const -> const any&;
262−
263− auto extractPointer() const -> const void*;
264−
265− static auto extract_value(const any&) -> const any&;
266−
267− auto operator==(const any&) const -> bool;
268− auto operator==(const long) const -> bool;
269− auto operator==(const double) const -> bool;
270− auto operator==(const char) const -> bool;
271− auto operator==(const bool) const -> bool;
272− auto operator==(const string&) const -> bool;
273− auto operator==(const char * const) const -> bool;
274−
275− auto operator!=(const any&) const -> bool;
276− auto operator!=(const long) const -> bool;
277− auto operator!=(const double) const -> bool;
278− auto operator!=(const char) const -> bool;
279− auto operator!=(const bool) const -> bool;
280− auto operator!=(const string&) const -> bool;
281− auto operator!=(const char * const) const -> bool;
282−
283− auto operator<(const any&) const -> bool;
284− auto operator<(const long) const -> bool;
285− auto operator<(const double) const -> bool;
286− auto operator<(const char) const -> bool;
287− auto operator<(const bool) const -> bool;
288− auto operator<(const string&) const -> bool;
289− auto operator<(const char * const) const -> bool;
290−
291− auto operator<=(const any&) const -> bool;
292− auto operator<=(const long) const -> bool;
293− auto operator<=(const double) const -> bool;
294− auto operator<=(const char) const -> bool;
295− auto operator<=(const bool) const -> bool;
296− auto operator<=(const string&) const -> bool;
297− auto operator<=(const char * const) const -> bool;
298−
299− auto operator>(const any&) const -> bool;
300− auto operator>(const long) const -> bool;
301− auto operator>(const double) const -> bool;
302− auto operator>(const char) const -> bool;
303− auto operator>(const bool) const -> bool;
304− auto operator>(const string&) const -> bool;
305− auto operator>(const char * const) const -> bool;
306−
307− auto operator>=(const any&) const -> bool;
308− auto operator>=(const long) const -> bool;
309− auto operator>=(const double) const -> bool;
310− auto operator>=(const char) const -> bool;
311− auto operator>=(const bool) const -> bool;
312− auto operator>=(const string&) const -> bool;
313− auto operator>=(const char * const) const -> bool;
314−
315− auto operator+(const any&) const -> any;
316− auto operator+(const long) const -> long;
317− auto operator+(const double) const -> double;
318− auto operator+(const char) const -> char;
319− auto operator+(const string&) const -> string;
320− auto operator+(const char * const) const -> string;
321−
322− auto operator-(const any&) const -> any;
323− auto operator-(const long) const -> long;
324− auto operator-(const double) const -> double;
325− auto operator-(const char) const -> char;
326−
327− auto operator*(const any&) const -> any;
328− auto operator*(const long) const -> long;
329− auto operator*(const double) const -> double;
330−
331− auto operator/(const any&) const -> any;
332− auto operator/(const long) const -> long;
333− auto operator/(const double) const -> double;
334−
335− auto operator%(const any&) const -> any;
336− auto operator%(const long) const -> long;
337−
338− auto operator-() const -> any; // unary negate
339−
340− friend auto operator==(const long, const any&) -> bool;
341− friend auto operator!=(const long, const any&) -> bool;
342− friend auto operator< (const long, const any&) -> bool;
343− friend auto operator<=(const long, const any&) -> bool;
344− friend auto operator> (const long, const any&) -> bool;
345− friend auto operator>=(const long, const any&) -> bool;
346−
347− friend auto operator==(const double, const any&) -> bool;
348− friend auto operator!=(const double, const any&) -> bool;
349− friend auto operator< (const double, const any&) -> bool;
350− friend auto operator<=(const double, const any&) -> bool;
351− friend auto operator> (const double, const any&) -> bool;
352− friend auto operator>=(const double, const any&) -> bool;
353−
354− friend auto operator==(const char, const any&) -> bool;
355− friend auto operator!=(const char, const any&) -> bool;
356− friend auto operator< (const char, const any&) -> bool;
357− friend auto operator<=(const char, const any&) -> bool;
358− friend auto operator> (const char, const any&) -> bool;
359− friend auto operator>=(const char, const any&) -> bool;
360−
361− friend auto operator==(const bool, const any&) -> bool;
362− friend auto operator!=(const bool, const any&) -> bool;
363− friend auto operator< (const bool, const any&) -> bool;
364− friend auto operator<=(const bool, const any&) -> bool;
365− friend auto operator> (const bool, const any&) -> bool;
366− friend auto operator>=(const bool, const any&) -> bool;
367−
368− friend auto operator==(const string&, const any&) -> bool;
369− friend auto operator!=(const string&, const any&) -> bool;
370− friend auto operator< (const string&, const any&) -> bool;
371− friend auto operator<=(const string&, const any&) -> bool;
372− friend auto operator> (const string&, const any&) -> bool;
373− friend auto operator>=(const string&, const any&) -> bool;
374−
375− friend auto operator==(const char* const, const any&) -> bool;
376− friend auto operator!=(const char* const, const any&) -> bool;
377− friend auto operator< (const char* const, const any&) -> bool;
378− friend auto operator<=(const char* const, const any&) -> bool;
379− friend auto operator> (const char* const, const any&) -> bool;
380− friend auto operator>=(const char* const, const any&) -> bool;
381−
382− friend auto operator+(const long, const any&) -> long;
383− friend auto operator-(const long, const any&) -> long;
384− friend auto operator*(const long, const any&) -> long;
385− friend auto operator/(const long, const any&) -> long;
386− friend auto operator%(const long, const any&) -> long;
387−
388− friend auto operator+(const double, const any&) -> double;
389− friend auto operator-(const double, const any&) -> double;
390− friend auto operator*(const double, const any&) -> double;
391− friend auto operator/(const double, const any&) -> double;
392−
393− friend auto operator+(const char, const any&) -> char;
394− friend auto operator-(const char, const any&) -> char;
395−
396− friend auto operator+(const string&, const any&) -> string;
397− friend auto operator+(const char* const, const any&) -> string;
398−
399−};
400−
401−} // namespace PureScript
402−
403−#endif // PureScript_HH
psc-bundle/Main.hsdeleted−138
@@ -1,138 +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 PatternGuards #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# LANGUAGE TupleSections #-}
19−{-# LANGUAGE RecordWildCards #-}
20−
21−module Main (main) where
22−
23−import Data.Traversable (for)
24−import Data.Version (showVersion)
25−
26−import Control.Applicative
27−import Control.Monad
28−import Control.Monad.Error.Class
29−import Control.Monad.Trans.Except
30−import Control.Monad.IO.Class
31−
32−import System.FilePath (takeFileName, takeDirectory)
33−import System.FilePath.Glob (glob)
34−import System.Exit (exitFailure)
35−import System.IO (stderr, hPutStrLn)
36−import System.Directory (createDirectoryIfMissing)
37−
38−import Language.PureScript.Bundle
39−
40−import Options.Applicative as Opts
41−
42−import qualified Paths_purescript as Paths
43−
44−-- | Command line options.
45−data Options = Options
46− { optionsInputFiles :: [FilePath]
47− , optionsOutputFile :: Maybe FilePath
48− , optionsEntryPoints :: [String]
49− , optionsMainModule :: Maybe String
50− , optionsNamespace :: String
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 :: forall m. (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− return (mid, js)
74−
75− let entryIds = (map (`ModuleIdentifier` Regular) optionsEntryPoints)
76−
77− bundle input entryIds optionsMainModule optionsNamespace
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− where
87− inputFile :: Parser FilePath
88− inputFile = strArgument $
89− metavar "FILE"
90− <> help "The input .js file(s)"
91−
92− outputFile :: Parser FilePath
93− outputFile = strOption $
94− short 'o'
95− <> long "output"
96− <> help "The output .js file"
97−
98− entryPoint :: Parser String
99− entryPoint = strOption $
100− short 'm'
101− <> long "module"
102− <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
103−
104− mainModule :: Parser String
105− mainModule = strOption $
106− long "main"
107− <> help "Generate code to run the main method in the specified module."
108−
109− namespace :: Parser String
110− namespace = strOption $
111− short 'n'
112− <> long "namespace"
113− <> Opts.value "PS"
114− <> showDefault
115− <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
116−
117−-- | Make it go.
118−main :: IO ()
119−main = do
120− opts <- execParser (info (version <*> helper <*> options) infoModList)
121− output <- runExceptT (app opts)
122− case output of
123− Left err -> do
124− hPutStrLn stderr (unlines (printErrorMessage err))
125− exitFailure
126− Right js ->
127− case optionsOutputFile opts of
128− Just outputFile -> do
129− createDirectoryIfMissing True (takeDirectory outputFile)
130− writeFile outputFile js
131− Nothing -> putStrLn js
132− where
133− infoModList = fullDesc <> headerInfo <> footerInfo
134− headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
135− footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
136−
137− version :: Parser (a -> a)
138− 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 . concat . (map renderModCtags)
9−
10−renderModCtags :: (String, P.Module) -> [String]
11−renderModCtags (path, mdl) = sort tagLines
12− where tagLines = map tagLine $ tags mdl
13− tagLine (name, line) = name ++ "\t" ++ path ++ "\t" ++ show line
psc-docs/Etags.hsdeleted−15
@@ -1,15 +0,0 @@
1−module Etags (dumpEtags) where
2−
3−import qualified Language.PureScript as P
4−import Tags
5−
6−dumpEtags :: [(String, P.Module)] -> [String]
7−dumpEtags = concat . (map renderModEtags)
8−
9−renderModEtags :: (String, P.Module) -> [String]
10−renderModEtags (path, mdl) = ["\x0c", path ++ "," ++ show tagsLen] ++ tagLines
11− where tagsLen = sum $ map length tagLines
12− tagLines = map tagLine $ tags mdl
13− tagLine (name, line) = "\x7f" ++ name ++ "\x01" ++ show line ++ ","
14−
15−
psc-docs/Main.hsdeleted−251
@@ -1,251 +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 (D.ParseError err) -> do
74− hPutStrLn stderr $ show err
75− exitFailure
76− Left (D.SortModulesError err) -> do
77− hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
78− exitFailure
79− Left (D.DesugarError err) -> do
80− hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
81− exitFailure
82− Right ms' ->
83− case output of
84− EverythingToStdOut ->
85− putStrLn (D.renderModulesAsMarkdown ms')
86− ToStdOut names -> do
87− let (ms, missing) = takeModulesByName ms' names
88− guardMissing missing
89− putStrLn (D.renderModulesAsMarkdown ms)
90− ToFiles names -> do
91− let (ms, missing) = takeModulesByName' ms' names
92− guardMissing missing
93− let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
94− forM_ ms'' $ \grp -> do
95− let fp = fst (head grp)
96− createDirectoryIfMissing True (takeDirectory fp)
97− writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
98− where
99− guardMissing [] = return ()
100− guardMissing [mn] = do
101− hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
102− exitFailure
103− guardMissing mns = do
104− hPutStrLn stderr "psc-docs: error: unknown modules:"
105− forM_ mns $ \mn ->
106− hPutStrLn stderr (" * " ++ show mn)
107− exitFailure
108−
109−-- |
110−-- Given a list of module names and a list of modules, return a list of modules
111−-- whose names appeared in the given name list, together with a list of names
112−-- for which no module could be found in the module list.
113−--
114−takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
115−takeModulesByName modules names =
116− first (map fst) (takeModulesByName' modules (map (,()) names))
117−
118−-- |
119−-- Like takeModulesByName but also keeps some extra data with the module.
120−--
121−takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
122−takeModulesByName' modules = foldl go ([], [])
123− where
124− go (ms, missing) (name, x) =
125− case find ((== name) . P.getModuleName) modules of
126− Just m -> ((m, x) : ms, missing)
127− Nothing -> (ms, name : missing)
128−
129−dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
130−dumpTags input renderTags = do
131− e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
132− case e of
133− Left err -> do
134− hPutStrLn stderr (show err)
135− exitFailure
136− Right ms ->
137− ldump (renderTags (pairs ms))
138−
139− where
140− pairs :: [(Maybe String, m)] -> [(String, m)]
141− pairs = map (first (fromMaybe ""))
142−
143− ldump :: [String] -> IO ()
144− ldump = mapM_ putStrLn
145−
146−parseFile :: FilePath -> IO (FilePath, String)
147−parseFile input = (,) input <$> readFile input
148−
149−inputFile :: Parser FilePath
150−inputFile = strArgument $
151− metavar "FILE"
152− <> help "The input .purs file(s)"
153−
154−instance Read Format where
155− readsPrec _ "etags" = [(Etags, "")]
156− readsPrec _ "ctags" = [(Ctags, "")]
157− readsPrec _ "markdown" = [(Markdown, "")]
158− readsPrec _ _ = []
159−
160−format :: Parser Format
161−format = option auto $ value Markdown
162− <> long "format"
163− <> metavar "FORMAT"
164− <> help "Set output FORMAT (markdown | etags | ctags)"
165−
166−docgenModule :: Parser String
167−docgenModule = strOption $
168− long "docgen"
169− <> 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."
170−
171−pscDocsOptions :: Parser (Format, [FilePath], [String])
172−pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
173−
174−parseDocgen :: [String] -> Either String DocgenOutput
175−parseDocgen [] = Right EverythingToStdOut
176−parseDocgen xs = go xs
177− where
178− go = intersperse " "
179− >>> concat
180− >>> words
181− >>> map parseItem
182− >>> combine
183−
184−data DocgenOutputItem
185− = IToStdOut P.ModuleName
186− | IToFile (P.ModuleName, FilePath)
187−
188−parseItem :: String -> DocgenOutputItem
189−parseItem s = case elemIndex ':' s of
190− Just i ->
191− s # splitAt i
192− >>> first P.moduleNameFromString
193− >>> second (drop 1)
194− >>> IToFile
195− Nothing ->
196− IToStdOut (P.moduleNameFromString s)
197−
198− where
199− infixr 1 #
200− (#) = flip ($)
201−
202−combine :: [DocgenOutputItem] -> Either String DocgenOutput
203−combine [] = Right EverythingToStdOut
204−combine (x:xs) = foldM go (initial x) xs
205− where
206− initial (IToStdOut m) = ToStdOut [m]
207− initial (IToFile m) = ToFiles [m]
208−
209− go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
210− go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
211− go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
212−
213−buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
214−buildOptions (fmt, input, mapping) =
215− case parseDocgen mapping of
216− Right mapping' -> return (PSCDocsOptions fmt input mapping')
217− Left err -> do
218− hPutStrLn stderr "psc-docs: error in --docgen option:"
219− hPutStrLn stderr (" " ++ err)
220− exitFailure
221−
222−main :: IO ()
223−main = execParser opts >>= buildOptions >>= docgen
224− where
225− opts = info (version <*> helper <*> pscDocsOptions) infoModList
226− infoModList = fullDesc <> headerInfo <> footerInfo
227− headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
228− footerInfo = footerDoc $ Just $ PP.vcat
229− [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
230−
231− version :: Parser (a -> a)
232− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
233−
234−examples :: PP.Doc
235−examples =
236− PP.vcat $ map PP.text
237− [ "Examples:"
238− , " print documentation for Data.List to stdout:"
239− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
240− , " --docgen Data.List"
241− , ""
242− , " write documentation for Data.List to docs/Data.List.md:"
243− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
244− , " --docgen Data.List:docs/Data.List.md"
245− , ""
246− , " write documentation for Data.List to docs/Data.List.md, and"
247− , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
248− , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
249− , " --docgen Data.List:docs/Data.List.md \\"
250− , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
251− ]
psc-docs/Tags.hsdeleted−18
@@ -1,18 +0,0 @@
1−module Tags where
2−
3−import qualified Language.PureScript as P
4−
5−tags :: P.Module -> [(String, Int)]
6−tags = concatMap dtags . P.exportedDeclarations
7− where dtags (P.PositionedDeclaration sp _ d) = map tag $ names d
8− where tag name = (name, line)
9− line = P.sourcePosLine $ P.spanStart sp
10− dtags _ = []
11− names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames
12− where consNames = map (\(cname, _) -> P.runProperName cname) dcons
13− names (P.TypeDeclaration ident _) = [show ident]
14− names (P.ExternDeclaration ident _) = [show ident]
15− names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]
16− names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]
17− names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]
18− names _ = []
psc-publish/Main.hsdeleted−38
@@ -1,38 +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−
13−dryRun :: Parser Bool
14−dryRun = switch $
15− long "dry-run"
16− <> help "Produce no output, and don't require a tagged version to be checked out."
17−
18−main :: IO ()
19−main = execParser opts >>= publish
20− where
21− opts = info (version <*> helper <*> dryRun) infoModList
22− infoModList = fullDesc <> headerInfo <> footerInfo
23− headerInfo = header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"
24− footerInfo = footer $ "psc-publish " ++ showVersion Paths.version
25−
26− version :: Parser (a -> a)
27− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
28−
29−publish :: Bool -> IO ()
30−publish isDryRun =
31− if isDryRun
32− then do
33− let dummyVersion = ("0.0.0", Version [0,0,0] [])
34− _ <- preparePackage $ defaultPublishOptions { publishGetVersion = return dummyVersion }
35− putStrLn "Dry run completed, no errors."
36− else do
37− pkg <- preparePackage defaultPublishOptions
38− BL.putStrLn (A.encode pkg)
psc-publish/tests/Test.hsdeleted−79
@@ -1,79 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2−{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−
5−-- | To run these tests:
6−--
7−-- * `cabal repl psc-publish`
8−-- * `:l psc-publish/tests/Test.hs`
9−-- * `test`
10−
11−module Test where
12−
13−import Control.Monad
14−import Control.Applicative
15−import Control.Exception
16−import System.Process
17−import System.Directory
18−import qualified Data.ByteString.Lazy as BL
19−import Data.ByteString.Lazy (ByteString)
20−import qualified Data.Aeson as A
21−import Data.Aeson.BetterErrors
22−
23−import Main
24−import Language.PureScript.Docs
25−
26−pkgName = "purescript-prelude"
27−packageUrl = "https://github.com/purescript/" ++ pkgName
28−packageDir = "tmp/" ++ pkgName
29−
30−pushd :: forall a. FilePath -> IO a -> IO a
31−pushd dir act = do
32− original <- getCurrentDirectory
33− setCurrentDirectory dir
34− result <- try act :: IO (Either IOException a)
35− setCurrentDirectory original
36− either throwIO return result
37−
38−clonePackage :: IO ()
39−clonePackage = do
40− createDirectoryIfMissing True packageDir
41− pushd packageDir $ do
42− exists <- doesDirectoryExist ".git"
43− unless exists $ do
44− putStrLn ("Cloning " ++ pkgName ++ " into " ++ packageDir ++ "...")
45− readProcess "git" ["clone", packageUrl, "."] "" >>= putStr
46− readProcess "git" ["tag", "v999.0.0"] "" >>= putStr
47−
48−bowerInstall :: IO ()
49−bowerInstall = do
50− pushd packageDir $ do
51− readProcess "bower" ["install"] "" >>= putStr
52−
53−getPackage :: IO UploadedPackage
54−getPackage = do
55− clonePackage
56− bowerInstall
57− pushd packageDir preparePackage
58−
59−data TestResult
60− = ParseFailed String
61− | Mismatch ByteString ByteString -- ^ encoding before, encoding after
62− | Pass ByteString
63− deriving (Show, Read)
64−
65−-- | Test JSON encoding/decoding; parse the package, roundtrip to/from JSON,
66−-- and check we get the same string.
67−test :: IO TestResult
68−test = roundTrip <$> getPackage
69−
70−roundTrip :: UploadedPackage -> TestResult
71−roundTrip pkg =
72− let before = A.encode pkg
73− in case A.eitherDecode before of
74− Left err -> ParseFailed err
75− Right parsed -> do
76− let after = A.encode (parsed :: UploadedPackage)
77− if before == after
78− then Pass before
79− else Mismatch before after
psc/Main.hsdeleted−192
@@ -1,192 +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−
31−import Options.Applicative as Opts
32−
33−import System.Exit (exitSuccess, exitFailure)
34−import System.IO (hPutStrLn, stderr)
35−import System.IO.UTF8
36−import System.FilePath.Glob (glob)
37−
38−import qualified Language.PureScript as P
39−import qualified Paths_purescript as Paths
40−
41−import Language.PureScript.Make
42−
43−data PSCMakeOptions = PSCMakeOptions
44− { pscmInput :: [FilePath]
45− , pscmForeignInput :: [FilePath]
46− , pscmOutputDir :: FilePath
47− , pscmOpts :: P.Options
48− , pscmUsePrefix :: Bool
49− }
50−
51−data InputOptions = InputOptions
52− { ioInputFiles :: [FilePath]
53− }
54−
55−compile :: PSCMakeOptions -> IO ()
56−compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
57− input <- globWarningOnMisses warnFileTypeNotFound inputGlob
58− when (null input) $ do
59− hPutStrLn stderr "psc: No input files."
60− exitFailure
61− let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
62− moduleFiles <- readInput (InputOptions pursFiles)
63− inputForeign <- globWarningOnMisses warnFileTypeNotFound inputForeignGlob
64− foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)
65− case runWriterT (parseInputs moduleFiles foreignFiles) of
66− Left errs -> do
67− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
68− exitFailure
69− Right ((ms, foreigns), warnings) -> do
70− when (P.nonEmpty warnings) $
71− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
72− let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
73− makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix
74− e <- runMake opts $ P.make makeActions (map snd ms)
75− case e of
76− Left errs -> do
77− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
78− exitFailure
79− Right (_, warnings') -> do
80− when (P.nonEmpty warnings') $
81− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
82− exitSuccess
83−
84−warnFileTypeNotFound :: String -> IO ()
85−warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
86−
87−globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
88−globWarningOnMisses warn = concatMapM globWithWarning
89− where
90− globWithWarning pattern = do
91− paths <- glob pattern
92− when (null paths) $ warn pattern
93− return paths
94− concatMapM f = liftM concat . mapM f
95−
96−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
97−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
98−
99−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
100− => [(Either P.RebuildPolicy FilePath, String)]
101− -> [(FilePath, P.ForeignJS)]
102− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
103−parseInputs modules foreigns =
104− (,) <$> P.parseModulesFromFiles (either (const "") id) modules
105− <*> P.parseForeignModulesFromFiles foreigns
106−
107−inputFile :: Parser FilePath
108−inputFile = strArgument $
109− metavar "FILE"
110− <> help "The input .purs file(s)"
111−
112−inputForeignFile :: Parser FilePath
113−inputForeignFile = strOption $
114− short 'f'
115− <> long "ffi"
116− <> help "The input .js file(s) providing foreign import implementations"
117−
118−outputDirectory :: Parser FilePath
119−outputDirectory = strOption $
120− short 'o'
121− <> long "output"
122− <> Opts.value "output"
123− <> showDefault
124− <> help "The output directory"
125−
126−requirePath :: Parser (Maybe FilePath)
127−requirePath = optional $ strOption $
128− short 'r'
129− <> long "require-path"
130− <> help "The path prefix to use for require() calls in the generated JavaScript"
131−
132−noTco :: Parser Bool
133−noTco = switch $
134− long "no-tco"
135− <> help "Disable tail call optimizations"
136−
137−noMagicDo :: Parser Bool
138−noMagicDo = switch $
139− long "no-magic-do"
140− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
141−
142−noOpts :: Parser Bool
143−noOpts = switch $
144− long "no-opts"
145− <> help "Skip the optimization phase"
146−
147−comments :: Parser Bool
148−comments = switch $
149− short 'c'
150− <> long "comments"
151− <> help "Include comments in the generated code"
152−
153−verboseErrors :: Parser Bool
154−verboseErrors = switch $
155− short 'v'
156− <> long "verbose-errors"
157− <> help "Display verbose error messages"
158−
159−noPrefix :: Parser Bool
160−noPrefix = switch $
161− short 'p'
162− <> long "no-prefix"
163− <> help "Do not include comment header"
164−
165−
166−options :: Parser P.Options
167−options = P.Options <$> noTco
168− <*> noMagicDo
169− <*> pure Nothing
170− <*> noOpts
171− <*> verboseErrors
172− <*> (not <$> comments)
173− <*> requirePath
174−
175−pscMakeOptions :: Parser PSCMakeOptions
176−pscMakeOptions = PSCMakeOptions <$> many inputFile
177− <*> many inputForeignFile
178− <*> outputDirectory
179− <*> options
180− <*> (not <$> noPrefix)
181−
182−
183−main :: IO ()
184−main = execParser opts >>= compile
185− where
186− opts = info (version <*> helper <*> pscMakeOptions) infoModList
187− infoModList = fullDesc <> headerInfo <> footerInfo
188− headerInfo = header "psc - Compiles PureScript to Javascript"
189− footerInfo = footer $ "psc " ++ showVersion Paths.version
190−
191− version :: Parser (a -> a)
192− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psci/Completion.hsdeleted−233
@@ -1,233 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−module Completion where
4−
5−import Data.Maybe (mapMaybe)
6−import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)
7−import Data.Char (isUpper)
8−import Data.Function (on)
9−#if __GLASGOW_HASKELL__ < 710
10−import Data.Traversable (traverse)
11−#endif
12−
13−import Control.Arrow (second)
14−#if __GLASGOW_HASKELL__ < 710
15−import Control.Applicative ((<$>), (<*>))
16−#endif
17−import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
18−import Control.Monad.Trans.State.Strict
19−
20−import System.Console.Haskeline
21−
22−import qualified Language.PureScript as P
23−import qualified Language.PureScript.Names as N
24−
25−import qualified Directive as D
26−import Types
27−
28−-- Completions may read the state, but not modify it.
29−type CompletionM = ReaderT PSCiState IO
30−
31−-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.
32−liftCompletionM :: CompletionM a -> StateT PSCiState IO a
33−liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)
34−
35−-- Haskeline completions
36−
37−data CompletionContext
38− = CtxDirective String
39− | CtxFilePath String
40− | CtxModule
41− | CtxIdentifier
42− | CtxType
43− | CtxFixed String
44− deriving (Show, Read)
45−
46−-- |
47−-- Loads module, function, and file completions.
48−--
49−completion :: CompletionFunc (StateT PSCiState IO)
50−completion = liftCompletionM . completion'
51−
52−completion' :: CompletionFunc CompletionM
53−completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
54−
55−-- |
56−-- Decide what kind of completion we need based on input. This function expects
57−-- a list of complete words (to the left of the cursor) as the first argument,
58−-- and the current word as the second argument.
59−completionContext :: [String] -> String -> [CompletionContext]
60−completionContext [] _ = [CtxDirective "", CtxIdentifier, CtxFixed "import"]
61−completionContext ws w | headSatisfies (":" `isPrefixOf`) ws = completeDirective ws w
62−completionContext ws w | headSatisfies (== "import") ws = completeImport ws w
63−completionContext _ _ = [CtxIdentifier]
64−
65−completeDirective :: [String] -> String -> [CompletionContext]
66−completeDirective ws w =
67− case ws of
68− [] -> [CtxDirective w]
69− [dir] -> case D.directivesFor <$> stripPrefix ":" dir of
70− -- only offer completions if the directive is unambiguous
71− Just [dir'] -> directiveArg w dir'
72− _ -> []
73−
74− -- All directives take exactly one argument. If we haven't yet matched,
75− -- that means one argument has already been supplied. So don't complete
76− -- any others.
77− _ -> []
78−
79−directiveArg :: String -> Directive -> [CompletionContext]
80−directiveArg _ Browse = [CtxModule]
81−directiveArg w Load = [CtxFilePath w]
82−directiveArg w Foreign = [CtxFilePath w]
83−directiveArg _ Quit = []
84−directiveArg _ Reset = []
85−directiveArg _ Help = []
86−directiveArg _ Show = map CtxFixed replQueryStrings
87−directiveArg _ Type = [CtxIdentifier]
88−directiveArg _ Kind = [CtxType]
89−
90−completeImport :: [String] -> String -> [CompletionContext]
91−completeImport ws w' =
92− case (ws, w') of
93− (["import"], w) | headSatisfies isUpper w -> [CtxModule]
94− (["import"], _) -> [CtxModule, CtxFixed "qualified"]
95− (["import", "qualified"], _) -> [CtxModule]
96− _ -> []
97−
98−headSatisfies :: (a -> Bool) -> [a] -> Bool
99−headSatisfies p str =
100− case str of
101− (c:_) -> p c
102− _ -> False
103−
104−-- | Callback for Haskeline's `completeWordWithPrev`.
105−-- Expects:
106−-- * Line contents to the left of the word, reversed
107−-- * Word to be completed
108−findCompletions :: String -> String -> CompletionM [Completion]
109−findCompletions prev word = do
110− let ctx = completionContext (words (reverse prev)) word
111− completions <- concat <$> traverse getCompletions ctx
112− return $ sortBy directivesFirst completions
113− where
114− getCompletions :: CompletionContext -> CompletionM [Completion]
115− getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
116−
117− prefixedBy :: String -> String -> Maybe Completion
118− prefixedBy w cand = if w `isPrefixOf` cand
119− then Just (simpleCompletion cand)
120− else Nothing
121−
122−getCompletion :: CompletionContext -> CompletionM [Either String Completion]
123−getCompletion ctx =
124− case ctx of
125− CtxFilePath f -> map Right <$> listFiles f
126− CtxModule -> map Left <$> getModuleNames
127− CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
128− CtxType -> map Left <$> getTypeNames
129− CtxFixed str -> return [Left str]
130− CtxDirective d -> return (map Left (completeDirectives d))
131−
132− where
133− completeDirectives :: String -> [String]
134− completeDirectives = map (':' :) . D.directiveStringsFor
135−
136−
137−getLoadedModules :: CompletionM [P.Module]
138−getLoadedModules = asks (map snd . psciLoadedModules)
139−
140−getImportedModules :: CompletionM [ImportedModule]
141−getImportedModules = asks psciImportedModules
142−
143−getModuleNames :: CompletionM [String]
144−getModuleNames = moduleNames <$> getLoadedModules
145−
146−mapLoadedModulesAndQualify :: (a -> String) -> (P.Module -> [(a, P.Declaration)]) -> CompletionM [String]
147−mapLoadedModulesAndQualify sho f = do
148− ms <- getLoadedModules
149− let argPairs = do m <- ms
150− fm <- f m
151− return (m, fm)
152− concat <$> traverse (uncurry (getAllQualifications sho)) argPairs
153−
154−getIdentNames :: CompletionM [String]
155−getIdentNames = mapLoadedModulesAndQualify P.showIdent identNames
156−
157−getDctorNames :: CompletionM [String]
158−getDctorNames = mapLoadedModulesAndQualify P.runProperName dctorNames
159−
160−getTypeNames :: CompletionM [String]
161−getTypeNames = mapLoadedModulesAndQualify P.runProperName typeDecls
162−
163−-- | Given a module and a declaration in that module, return all possible ways
164−-- it could have been referenced given the current PSCiState - including fully
165−-- qualified, qualified using an alias, and unqualified.
166−getAllQualifications :: (a -> String) -> P.Module -> (a, P.Declaration) -> CompletionM [String]
167−getAllQualifications sho m (declName, decl) = do
168− imports <- getAllImportsOf m
169− let fullyQualified = qualifyWith (Just (P.getModuleName m))
170− let otherQuals = nub (concatMap qualificationsUsing imports)
171− return $ fullyQualified : otherQuals
172− where
173− qualifyWith mMod = P.showQualified sho (P.Qualified mMod declName)
174− referencedBy refs = P.isExported (Just refs) decl
175−
176− qualificationsUsing (_, importType, asQ') =
177− let q = qualifyWith asQ'
178− in case importType of
179− P.Implicit -> [q]
180− P.Explicit refs -> if referencedBy refs
181− then [q]
182− else []
183− P.Hiding refs -> if referencedBy refs
184− then []
185− else [q]
186−
187−
188−-- | Returns all the ImportedModule values referring to imports of a particular
189−-- module.
190−getAllImportsOf :: P.Module -> CompletionM [ImportedModule]
191−getAllImportsOf = asks . allImportsOf
192−
193−nubOnFst :: Eq a => [(a, b)] -> [(a, b)]
194−nubOnFst = nubBy ((==) `on` fst)
195−
196−typeDecls :: P.Module -> [(N.ProperName, P.Declaration)]
197−typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations
198− where
199− getTypeName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)
200− getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)
201− getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)
202− getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
203− getTypeName _ = Nothing
204−
205−identNames :: P.Module -> [(N.Ident, P.Declaration)]
206−identNames = nubOnFst . concatMap getDeclNames . P.exportedDeclarations
207− where
208− getDeclNames :: P.Declaration -> [(P.Ident, P.Declaration)]
209− getDeclNames d@(P.ValueDeclaration ident _ _ _) = [(ident, d)]
210− getDeclNames d@(P.TypeDeclaration ident _ ) = [(ident, d)]
211− getDeclNames d@(P.ExternDeclaration ident _) = [(ident, d)]
212− getDeclNames d@(P.TypeClassDeclaration _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds
213− getDeclNames (P.PositionedDeclaration _ _ d) = getDeclNames d
214− getDeclNames _ = []
215−
216−dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]
217−dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
218− where
219− go :: P.Declaration -> [(N.ProperName, P.Declaration)]
220− go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)
221− go (P.PositionedDeclaration _ _ d) = go d
222− go _ = []
223−
224−moduleNames :: [P.Module] -> [String]
225−moduleNames ms = nub [P.runModuleName moduleName | P.Module _ _ moduleName _ _ <- ms]
226−
227−directivesFirst :: Completion -> Completion -> Ordering
228−directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
229− where
230− go (':' : xs) (':' : ys) = compare xs ys
231− go (':' : _) _ = LT
232− go _ (':' : _) = GT
233− 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−604
@@ -1,604 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : PSCi
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−-- PureScript Compiler Interactive.
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DoAndIfThenElse #-}
17−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18−{-# LANGUAGE RecordWildCards #-}
19−{-# LANGUAGE TupleSections #-}
20−{-# LANGUAGE CPP #-}
21−
22−module PSCi where
23−
24−import Data.Foldable (traverse_)
25−import Data.List (intercalate, nub, sort)
26−#if __GLASGOW_HASKELL__ < 710
27−import Data.Traversable (traverse)
28−#endif
29−import Data.Tuple (swap)
30−import Data.Version (showVersion)
31−import qualified Data.Map as M
32−
33−import Control.Applicative
34−import Control.Arrow (first)
35−import Control.Monad
36−import Control.Monad.Error.Class (MonadError(..))
37−import Control.Monad.Trans.Class
38−import Control.Monad.Trans.Except (runExceptT)
39−import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
40−import Control.Monad.Trans.State.Strict
41−import Control.Monad.IO.Class (liftIO)
42−import Control.Monad.Writer.Strict (runWriter)
43−import qualified Control.Monad.Trans.State.Lazy as L
44−
45−import Options.Applicative as Opts
46−
47−import System.Console.Haskeline
48−import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)
49−import System.Exit
50−import System.FilePath (pathSeparator, (</>), isPathSeparator)
51−import System.FilePath.Glob (glob)
52−import System.Process (readProcessWithExitCode)
53−import System.IO.Error (tryIOError)
54−
55−import qualified Language.PureScript as P
56−import qualified Language.PureScript.Names as N
57−import qualified Paths_purescript as Paths
58−
59−import qualified Directive as D
60−import Completion (completion)
61−import IO (mkdirp)
62−import Parser (parseCommand)
63−import Types
64−
65−-- | The name of the PSCI support module
66−supportModuleName :: P.ModuleName
67−supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]
68−
69−-- | Support module, contains code to evaluate terms
70−supportModule :: P.Module
71−supportModule =
72− case P.parseModulesFromFiles id [("", code)] of
73− Right [(_, P.Module ss cs _ ds exps)] -> P.Module ss cs supportModuleName ds exps
74− _ -> error "Support module could not be parsed"
75− where
76− code :: String
77− code = unlines
78− [ "module S where"
79− , ""
80− , "import Prelude"
81− , "import Control.Monad.Eff"
82− , "import Control.Monad.Eff.Console"
83− , "import Control.Monad.Eff.Unsafe"
84− , ""
85− , "class Eval a where"
86− , " eval :: a -> Eff (console :: CONSOLE) Unit"
87− , ""
88− , "instance evalShow :: (Show a) => Eval a where"
89− , " eval = print"
90− , ""
91− , "instance evalEff :: (Eval a) => Eval (Eff eff a) where"
92− , " eval x = unsafeInterleaveEff x >>= eval"
93− ]
94−
95−-- File helpers
96−
97−onFirstFileMatching :: Monad m => (b -> m (Maybe a)) -> [b] -> m (Maybe a)
98−onFirstFileMatching f pathVariants = runMaybeT . msum $ map (MaybeT . f) pathVariants
99−
100−-- |
101−-- Locates the node executable.
102−-- Checks for either @nodejs@ or @node@.
103−--
104−findNodeProcess :: IO (Maybe String)
105−findNodeProcess = onFirstFileMatching findExecutable names
106− where names = ["nodejs", "node"]
107−
108−-- |
109−-- Grabs the filename where the history is stored.
110−--
111−getHistoryFilename :: IO FilePath
112−getHistoryFilename = do
113− home <- getHomeDirectory
114− let filename = home </> ".purescript" </> "psci_history"
115− mkdirp filename
116− return filename
117−
118−-- |
119−-- Loads a file for use with imports.
120−--
121−loadModule :: FilePath -> IO (Either String [P.Module])
122−loadModule filename = do
123− content <- readFile filename
124− return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
125−
126−-- |
127−-- Load all modules.
128−--
129−loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])
130−loadAllModules files = do
131− filesAndContent <- forM files $ \filename -> do
132− content <- readFile filename
133− return (Right filename, content)
134− return $ P.parseModulesFromFiles (either (const "") id) filesAndContent
135−
136−-- |
137−-- Load all modules, updating the application state
138−--
139−loadAllImportedModules :: PSCI ()
140−loadAllImportedModules = do
141− files <- PSCI . lift $ fmap psciImportedFilenames get
142− modulesOrFirstError <- psciIO $ loadAllModules files
143− case modulesOrFirstError of
144− Left errs -> printErrors errs
145− Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
146−
147−-- |
148−-- Expands tilde in path.
149−--
150−expandTilde :: FilePath -> IO FilePath
151−expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
152−expandTilde p = return p
153−
154−-- Messages
155−
156−-- |
157−-- The help message.
158−--
159−helpMessage :: String
160−helpMessage = "The following commands are available:\n\n " ++
161− intercalate "\n " (map line D.help) ++
162− "\n\n" ++ extraHelp
163− where
164− line :: (Directive, String, String) -> String
165− line (dir, arg, desc) =
166− let cmd = ':' : D.stringFor dir
167− in unwords [ cmd
168− , replicate (11 - length cmd) ' '
169− , arg
170− , replicate (11 - length arg) ' '
171− , desc
172− ]
173−
174− extraHelp =
175− "Further information is available on the PureScript wiki:\n" ++
176− " --> https://github.com/purescript/purescript/wiki/psci"
177−
178−
179−-- |
180−-- The welcome prologue.
181−--
182−prologueMessage :: String
183−prologueMessage = intercalate "\n"
184− [ " ____ ____ _ _ "
185− , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
186− , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
187− , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
188− , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
189− , " |_| "
190− , ""
191− , ":? shows help"
192− ]
193−
194−-- |
195−-- The quit message.
196−--
197−quitMessage :: String
198−quitMessage = "See ya!"
199−
200−-- |
201−-- PSCI monad
202−--
203−newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
204−
205−psciIO :: IO a -> PSCI a
206−psciIO io = PSCI . lift $ lift io
207−
208−-- |
209−-- Makes a volatile module to execute the current expression.
210−--
211−createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module
212−createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =
213− let
214− moduleName = P.ModuleName [P.ProperName "$PSCI"]
215− trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))
216− mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))
217− itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val
218− mainDecl = P.ValueDeclaration (P.Ident "main") P.Public [] $ Right mainValue
219− decls = if exec then [itDecl, mainDecl] else [itDecl]
220− in
221− P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
222−
223−
224−-- |
225−-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
226−--
227−createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
228−createTemporaryModuleForKind PSCiState{psciImportedModules = imports, psciLetBindings = lets} typ =
229− let
230− moduleName = P.ModuleName [P.ProperName "$PSCI"]
231− itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
232− in
233− P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ [itDecl]) Nothing
234−
235−-- |
236−-- Makes a volatile module to execute the current imports.
237−--
238−createTemporaryModuleForImports :: PSCiState -> P.Module
239−createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
240− let
241− moduleName = P.ModuleName [P.ProperName "$PSCI"]
242− in
243− P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName (importDecl `map` imports) Nothing
244−
245−importDecl :: ImportedModule -> P.Declaration
246−importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
247−
248−indexFile :: FilePath
249−indexFile = ".psci_modules" ++ pathSeparator : "index.js"
250−
251−modulesDir :: FilePath
252−modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
253−
254−-- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the
255−-- options and ignores the warning messages.
256−runMake :: P.Make a -> IO (Either P.MultipleErrors a)
257−runMake mk = fmap (fmap fst) $ P.runMake P.defaultOptions mk
258−
259−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> P.Make a
260−makeIO f io = do
261− e <- liftIO $ tryIOError io
262− either (throwError . P.singleError . f) return e
263−
264−make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> P.Make P.Environment
265−make PSCiState{..} ms = P.make actions' (map snd (psciLoadedModules ++ ms))
266− where
267− filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)
268− actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False
269− actions' = actions { P.progress = const (return ()) }
270−
271−-- |
272−-- Takes a value declaration and evaluates it with the current state.
273−--
274−handleDeclaration :: P.Expr -> PSCI ()
275−handleDeclaration val = do
276− st <- PSCI $ lift get
277− let m = createTemporaryModule True st val
278− let nodeArgs = psciNodeFlags st ++ [indexFile]
279− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]
280− case e of
281− Left errs -> printErrors errs
282− Right _ -> do
283− psciIO $ writeFile indexFile "require('$PSCI').main();"
284− process <- psciIO findNodeProcess
285− result <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
286− case result of
287− Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
288− Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
289− Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
290−
291−-- |
292−-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
293−-- restore the original environment.
294−--
295−handleDecls :: [P.Declaration] -> PSCI ()
296−handleDecls ds = do
297− st <- PSCI $ lift get
298− let st' = updateLets ds st
299− let m = createTemporaryModule False st' (P.ObjectLiteral [])
300− e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]
301− case e of
302− Left err -> printErrors err
303− Right _ -> PSCI $ lift (put st')
304−
305−-- |
306−-- Show actual loaded modules in psci.
307−--
308−handleShowLoadedModules :: PSCI ()
309−handleShowLoadedModules = do
310− PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get
311− psciIO $ readModules loadedModules >>= putStrLn
312− return ()
313− where readModules = return . unlines . sort . nub . map toModuleName
314− toModuleName = N.runModuleName . (\ (P.Module _ _ mdName _ _) -> mdName) . snd
315−
316−-- |
317−-- Show the imported modules in psci.
318−--
319−handleShowImportedModules :: PSCI ()
320−handleShowImportedModules = do
321− PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get
322− psciIO $ showModules importedModules >>= putStrLn
323− return ()
324− where
325− showModules = return . unlines . sort . map showModule
326− showModule (mn, declType, asQ) =
327− "import " ++ case asQ of
328− Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
329− Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
330−
331− showDeclType P.Implicit = ""
332− showDeclType (P.Explicit refs) = refsList refs
333− showDeclType (P.Hiding refs) = "hiding " ++ refsList refs
334− refsList refs = "(" ++ commaList (map showRef refs) ++ ")"
335−
336− showRef :: P.DeclarationRef -> String
337− showRef (P.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
338− showRef (P.ValueRef ident) = show ident
339− showRef (P.TypeClassRef pn) = show pn
340− showRef (P.TypeInstanceRef ident) = show ident
341− showRef (P.ModuleRef name) = "module " ++ show name
342− showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
343−
344− commaList :: [String] -> String
345− commaList = intercalate ", "
346−
347−-- |
348−-- Imports a module, preserving the initial state on failure.
349−--
350−handleImport :: ImportedModule -> PSCI ()
351−handleImport im = do
352− st <- updateImportedModules im <$> PSCI (lift get)
353− let m = createTemporaryModuleForImports st
354− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
355− case e of
356− Left errs -> printErrors errs
357− Right _ -> do
358− PSCI $ lift $ put st
359− return ()
360−
361−-- |
362−-- Takes a value and prints its type
363−--
364−handleTypeOf :: P.Expr -> PSCI ()
365−handleTypeOf val = do
366− st <- PSCI $ lift get
367− let m = createTemporaryModule False st val
368− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
369− case e of
370− Left errs -> printErrors errs
371− Right env' ->
372− case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
373− Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
374− Nothing -> PSCI $ outputStrLn "Could not find type"
375−
376−-- |
377−-- Pretty print a module's signatures
378−--
379−printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()
380−printModuleSignatures moduleName env =
381− PSCI $ let namesEnv = P.names env
382− moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) namesEnv
383− in case moduleNamesIdent of
384− [] -> outputStrLn $ "This module '"++ P.runModuleName moduleName ++"' does not export functions."
385− _ -> ( outputStrLn
386− . unlines
387− . sort
388− . map (showType . findType namesEnv)) moduleNamesIdent
389− where findType :: M.Map (P.ModuleName, P.Ident) (P.Type, P.NameKind, P.NameVisibility) -> (P.ModuleName, P.Ident) -> (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility))
390− findType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)
391− showType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> String
392− showType (mIdent, Just (mType, _, _)) = show mIdent ++ " :: " ++ P.prettyPrintType mType
393− showType _ = error "The impossible happened in printModuleSignatures."
394−
395−-- |
396−-- Browse a module and displays its signature (if module exists).
397−--
398−handleBrowse :: P.ModuleName -> PSCI ()
399−handleBrowse moduleName = do
400− st <- PSCI $ lift get
401− env <- psciIO . runMake $ make st []
402− case env of
403− Left errs -> printErrors errs
404− Right env' ->
405− if moduleName `notElem` (nub . map ((\ (P.Module _ _ modName _ _ ) -> modName) . snd)) (psciLoadedModules st)
406− then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."
407− else printModuleSignatures moduleName env'
408−
409−-- | Pretty-print errors
410−printErrors :: P.MultipleErrors -> PSCI ()
411−printErrors = PSCI . outputStrLn . P.prettyPrintMultipleErrors False
412−
413−-- |
414−-- Takes a value and prints its kind
415−--
416−handleKindOf :: P.Type -> PSCI ()
417−handleKindOf typ = do
418− st <- PSCI $ lift get
419− let m = createTemporaryModuleForKind st typ
420− mName = P.ModuleName [P.ProperName "$PSCI"]
421− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
422− case e of
423− Left errs -> printErrors errs
424− Right env' ->
425− case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
426− Just (_, typ') -> do
427− let chk = P.CheckState env' 0 0 (Just mName)
428− k = fst . runWriter . runExceptT $ L.runStateT (P.unCheck (P.kindOf mName typ')) chk
429− case k of
430− Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
431− Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
432− Nothing -> PSCI $ outputStrLn "Could not find kind"
433−
434−-- Commands
435−
436−-- |
437−-- Parses the input and returns either a Metacommand, or an error as a string.
438−--
439−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
440−getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do
441− firstLine <- withInterrupt $ getInputLine "> "
442− case firstLine of
443− Nothing -> return (Right (Just QuitPSCi)) -- Ctrl-D when input is empty
444− Just "" -> return (Right Nothing)
445− Just s | singleLineMode || head s == ':' -> return . either Left (Right . Just) $ parseCommand s
446− Just s -> either Left (Right . Just) . parseCommand <$> go [s]
447− where
448− go :: [String] -> InputT (StateT PSCiState IO) String
449− go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
450−
451−-- |
452−-- Performs an action for each meta-command given, and also for expressions.
453−--
454−handleCommand :: Command -> PSCI ()
455−handleCommand (Expression val) = handleDeclaration val
456−handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
457−handleCommand (Import im) = handleImport im
458−handleCommand (Decls l) = handleDecls l
459−handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do
460− PSCI . lift $ modify (updateImportedFiles absPath)
461− m <- psciIO $ loadModule absPath
462− case m of
463− Left err -> PSCI $ outputStrLn err
464− Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
465−handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do
466− foreignsOrError <- psciIO . runMake $ do
467− foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readFile absPath)
468− P.parseForeignModulesFromFiles [(absPath, foreignFile)]
469− case foreignsOrError of
470− Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err
471− Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)
472−handleCommand ResetState = do
473− files <- psciImportedFilenames <$> PSCI (lift get)
474− PSCI . lift . modify $ \st -> st
475− { psciImportedFilenames = files
476− , psciImportedModules = []
477− , psciLetBindings = []
478− }
479− loadAllImportedModules
480−handleCommand (TypeOf val) = handleTypeOf val
481−handleCommand (KindOf typ) = handleKindOf typ
482−handleCommand (BrowseModule moduleName) = handleBrowse moduleName
483−handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
484−handleCommand (ShowInfo QueryImport) = handleShowImportedModules
485−handleCommand QuitPSCi = error "`handleCommand QuitPSCi` was called. This is a bug."
486−
487−whenFileExists :: FilePath -> (FilePath -> PSCI ()) -> PSCI ()
488−whenFileExists filePath f = do
489− absPath <- psciIO $ expandTilde filePath
490− exists <- psciIO $ doesFileExist absPath
491− if exists
492− then f absPath
493− else PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
494−
495−-- |
496−-- Attempts to read initial commands from '.psci' in the present working
497−-- directory then the user's home
498−--
499−loadUserConfig :: IO (Maybe [Command])
500−loadUserConfig = onFirstFileMatching readCommands pathGetters
501− where
502− pathGetters = [getCurrentDirectory, getHomeDirectory]
503− readCommands :: IO FilePath -> IO (Maybe [Command])
504− readCommands path = do
505− configFile <- (</> ".psci") <$> path
506− exists <- doesFileExist configFile
507− if exists
508− then do
509− ls <- lines <$> readFile configFile
510− case mapM parseCommand ls of
511− Left err -> print err >> exitFailure
512− Right cs -> return $ Just cs
513− else
514− return Nothing
515−
516−
517−-- | Checks if the Console module is defined
518−consoleIsDefined :: [P.Module] -> Bool
519−consoleIsDefined = any ((== P.ModuleName (map P.ProperName [ "Control", "Monad", "Eff", "Console" ])) . P.getModuleName)
520−
521−-- |
522−-- The PSCI main loop.
523−--
524−loop :: PSCiOptions -> IO ()
525−loop PSCiOptions{..} = do
526− config <- loadUserConfig
527− inputFiles <- concat <$> mapM glob psciInputFile
528− foreignFiles <- concat <$> mapM glob psciForeignInputFiles
529− modulesOrFirstError <- loadAllModules inputFiles
530− case modulesOrFirstError of
531− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
532− Right modules -> do
533− historyFilename <- getHistoryFilename
534− let settings = defaultSettings { historyFile = Just historyFilename }
535− foreignsOrError <- runMake $ do
536− foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.ErrorMessage [] $ P.CannotReadFile inFile)) (readFile inFile))
537− P.parseForeignModulesFromFiles foreignFilesContent
538− case foreignsOrError of
539− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
540− Right foreigns ->
541− flip evalStateT (PSCiState inputFiles [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
542− outputStrLn prologueMessage
543− traverse_ (mapM_ (runPSCI . handleCommand)) config
544− modules' <- lift $ gets psciLoadedModules
545− unless (consoleIsDefined (map snd modules')) . outputStrLn $ unlines
546− [ "PSCi requires the purescript-console module to be installed."
547− , "For help getting started, visit http://wiki.purescript.org/PSCi"
548− ]
549− go
550− where
551− go :: InputT (StateT PSCiState IO) ()
552− go = do
553− c <- getCommand (not psciMultiLineMode)
554− case c of
555− Left err -> outputStrLn err >> go
556− Right Nothing -> go
557− Right (Just QuitPSCi) -> outputStrLn quitMessage
558− Right (Just c') -> do
559− handleInterrupt (outputStrLn "Interrupted.")
560− (withInterrupt (runPSCI (loadAllImportedModules >> handleCommand c')))
561− go
562−
563−multiLineMode :: Parser Bool
564−multiLineMode = switch $
565− long "multi-line-mode"
566− <> short 'm'
567− <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
568−
569−inputFile :: Parser FilePath
570−inputFile = strArgument $
571− metavar "FILE"
572− <> Opts.help "Optional .purs files to load on start"
573−
574−inputForeignFile :: Parser FilePath
575−inputForeignFile = strOption $
576− short 'f'
577− <> long "ffi"
578− <> help "The input .js file(s) providing foreign import implementations"
579−
580−nodeFlagsFlag :: Parser [String]
581−nodeFlagsFlag = option parser $
582− long "node-opts"
583− <> metavar "NODE_OPTS"
584− <> value []
585− <> Opts.help "Flags to pass to node, separated by spaces"
586− where
587− parser = words <$> str
588−
589−psciOptions :: Parser PSCiOptions
590−psciOptions = PSCiOptions <$> multiLineMode
591− <*> many inputFile
592− <*> many inputForeignFile
593− <*> nodeFlagsFlag
594−
595−runPSCi :: IO ()
596−runPSCi = execParser opts >>= loop
597− where
598− opts = info (version <*> helper <*> psciOptions) infoModList
599− infoModList = fullDesc <> headerInfo <> footerInfo
600− headerInfo = header "psci - Interactive mode for PureScript"
601− footerInfo = footer $ "psci " ++ showVersion Paths.version
602−
603− version :: Parser (a -> a)
604− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
psci/Parser.hsdeleted−143
@@ -1,143 +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−{-# LANGUAGE CPP #-}
17−
18−module Parser
19− ( parseCommand
20− ) where
21−
22−import Prelude hiding (lex)
23−
24−import Data.Char (isSpace)
25−import Data.List (intercalate)
26−
27−#if __GLASGOW_HASKELL__ < 710
28−import Control.Applicative hiding (many)
29−#endif
30−
31−import Text.Parsec hiding ((<|>))
32−
33−import qualified Language.PureScript as P
34−import Language.PureScript.Parser.Common (mark, same)
35−
36−import qualified Directive as D
37−import Types
38−
39−-- |
40−-- Parses PSCI metacommands or expressions input from the user.
41−--
42−parseCommand :: String -> Either String Command
43−parseCommand cmdString =
44− case cmdString of
45− (':' : cmd) -> parseDirective cmd
46− _ -> parseRest psciCommand cmdString
47−
48−parseRest :: P.TokenParser a -> String -> Either String a
49−parseRest p s = either (Left . show) Right $ do
50− ts <- P.lex "" s
51− P.runTokenParser "" (p <* eof) ts
52−
53−psciCommand :: P.TokenParser Command
54−psciCommand = choice (map try parsers)
55− where
56− parsers =
57− [ psciLet
58− , psciImport
59− , psciOtherDeclaration
60− , psciExpression
61− ]
62−
63−trim :: String -> String
64−trim = trimEnd . trimStart
65−
66−trimStart :: String -> String
67−trimStart = dropWhile isSpace
68−
69−trimEnd :: String -> String
70−trimEnd = reverse . trimStart . reverse
71−
72−parseDirective :: String -> Either String Command
73−parseDirective cmd =
74− case D.directivesFor' dstr of
75− [(d, _)] -> commandFor d
76− [] -> Left "Unrecognized directive. Type :? for help."
77− ds -> Left ("Ambiguous directive. Possible matches: " ++
78− intercalate ", " (map snd ds) ++ ". Type :? for help.")
79− where
80− (dstr, arg) = break isSpace cmd
81−
82− commandFor d = case d of
83− Help -> return ShowHelp
84− Quit -> return QuitPSCi
85− Reset -> return ResetState
86− Browse -> BrowseModule <$> parseRest P.moduleName arg
87− Load -> return $ LoadFile (trim arg)
88− Foreign -> return $ LoadForeign (trim arg)
89− Show -> ShowInfo <$> parseReplQuery' (trim arg)
90− Type -> TypeOf <$> parseRest P.parseValue arg
91− Kind -> KindOf <$> parseRest P.parseType arg
92−
93−-- |
94−-- Parses expressions entered at the PSCI repl.
95−--
96−psciExpression :: P.TokenParser Command
97−psciExpression = Expression <$> P.parseValue
98−
99−-- |
100−-- PSCI version of @let@.
101−-- This is essentially let from do-notation.
102−-- However, since we don't support the @Eff@ monad,
103−-- we actually want the normal @let@.
104−--
105−psciLet :: P.TokenParser Command
106−psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
107− where
108− manyDecls :: P.TokenParser [P.Declaration]
109− manyDecls = mark (many1 (same *> P.parseLocalDeclaration))
110−
111−-- | Imports must be handled separately from other declarations, so that
112−-- :show import works, for example.
113−psciImport :: P.TokenParser Command
114−psciImport = Import <$> P.parseImportDeclaration'
115−
116−-- | Any other declaration that we don't need a 'special case' parser for
117−-- (like let or import declarations).
118−psciOtherDeclaration :: P.TokenParser Command
119−psciOtherDeclaration = Decls . (:[]) <$> do
120− decl <- discardPositionInfo <$> P.parseDeclaration
121− if acceptable decl
122− then return decl
123− else fail "this kind of declaration is not supported in psci"
124−
125−discardPositionInfo :: P.Declaration -> P.Declaration
126−discardPositionInfo (P.PositionedDeclaration _ _ d) = d
127−discardPositionInfo d = d
128−
129−acceptable :: P.Declaration -> Bool
130−acceptable P.DataDeclaration{} = True
131−acceptable P.TypeSynonymDeclaration{} = True
132−acceptable P.ExternDeclaration{} = True
133−acceptable P.ExternDataDeclaration{} = True
134−acceptable P.TypeClassDeclaration{} = True
135−acceptable P.TypeInstanceDeclaration{} = True
136−acceptable _ = False
137−
138−parseReplQuery' :: String -> Either String ReplQuery
139−parseReplQuery' str =
140− case parseReplQuery str of
141− Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++
142− intercalate ", " replQueryStrings ++ ".")
143− Just query -> Right query
psci/Types.hsdeleted−181
@@ -1,181 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Types
4−-- Copyright : (c) Phil Freeman 2014
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Type declarations and associated basic functions for PSCI.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Types where
17−
18−import qualified Data.Map as M
19−import qualified Language.PureScript as P
20−
21−data PSCiOptions = PSCiOptions
22− { psciMultiLineMode :: Bool
23− , psciInputFile :: [FilePath]
24− , psciForeignInputFiles :: [FilePath]
25− , psciInputNodeFlags :: [String]
26− }
27−
28−-- |
29−-- The PSCI state.
30−-- Holds a list of imported modules, loaded files, and partial let bindings.
31−-- The let bindings are partial,
32−-- because it makes more sense to apply the binding to the final evaluated expression.
33−--
34−data PSCiState = PSCiState
35− { psciImportedFilenames :: [FilePath]
36− , psciImportedModules :: [ImportedModule]
37− , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
38− , psciForeignFiles :: M.Map P.ModuleName FilePath
39− , psciLetBindings :: [P.Declaration]
40− , psciNodeFlags :: [String]
41− }
42−
43−-- | All of the data that is contained by an ImportDeclaration in the AST.
44−-- That is:
45−--
46−-- * A module name, the name of the module which is being imported
47−-- * An ImportDeclarationType which specifies whether there is an explicit
48−-- import list, a hiding list, or neither.
49−-- * If the module is imported qualified, its qualified name in the importing
50−-- module. Otherwise, Nothing.
51−--
52−type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)
53−
54−psciImportedModuleNames :: PSCiState -> [P.ModuleName]
55−psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
56− map (\(mn, _, _) -> mn) is
57−
58−allImportsOf :: P.Module -> PSCiState -> [ImportedModule]
59−allImportsOf m (PSCiState{psciImportedModules = is}) =
60− filter isImportOfThis is
61− where
62− name = P.getModuleName m
63− isImportOfThis (name', _, _) = name == name'
64−
65−-- State helpers
66−
67−-- |
68−-- Updates the state to have more imported modules.
69−--
70−updateImportedFiles :: FilePath -> PSCiState -> PSCiState
71−updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
72−
73−-- |
74−-- Updates the state to have more imported modules.
75−--
76−updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
77−updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
78−
79−-- |
80−-- Updates the state to have more loaded files.
81−--
82−updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
83−updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
84−
85−-- |
86−-- Updates the state to have more let bindings.
87−--
88−updateLets :: [P.Declaration] -> PSCiState -> PSCiState
89−updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
90−
91−-- |
92−-- Updates the state to have more let bindings.
93−--
94−updateForeignFiles :: M.Map P.ModuleName FilePath -> PSCiState -> PSCiState
95−updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `M.union` fs }
96−
97−-- |
98−-- Valid Meta-commands for PSCI
99−--
100−data Command
101− -- |
102− -- A purescript expression
103− --
104− = Expression P.Expr
105− -- |
106− -- Show the help (ie, list of directives)
107− --
108− | ShowHelp
109− -- |
110− -- Import a module from a loaded file
111− --
112− | Import ImportedModule
113− -- |
114− -- Browse a module
115− --
116− | BrowseModule P.ModuleName
117− -- |
118− -- Load a file for use with importing
119− --
120− | LoadFile FilePath
121− -- |
122− -- Load a foreign module
123− --
124− | LoadForeign FilePath
125− -- |
126− -- Exit PSCI
127− --
128− | QuitPSCi
129− -- |
130− -- Reset the state of the REPL
131− --
132− | ResetState
133− -- |
134− -- Add some declarations to the current evaluation context.
135− --
136− | Decls [P.Declaration]
137− -- |
138− -- Find the type of an expression
139− --
140− | TypeOf P.Expr
141− -- |
142− -- Find the kind of an expression
143− --
144− | KindOf P.Type
145− -- |
146− -- Shows information about the current state of the REPL
147− --
148− | ShowInfo ReplQuery
149−
150−data ReplQuery
151− = QueryLoaded
152− | QueryImport
153− deriving (Eq, Show)
154−
155−-- | A list of all ReplQuery values.
156−replQueries :: [ReplQuery]
157−replQueries = [QueryLoaded, QueryImport]
158−
159−replQueryStrings :: [String]
160−replQueryStrings = map showReplQuery replQueries
161−
162−showReplQuery :: ReplQuery -> String
163−showReplQuery QueryLoaded = "loaded"
164−showReplQuery QueryImport = "import"
165−
166−parseReplQuery :: String -> Maybe ReplQuery
167−parseReplQuery "loaded" = Just QueryLoaded
168−parseReplQuery "import" = Just QueryImport
169−parseReplQuery _ = Nothing
170−
171−data Directive
172− = Help
173− | Quit
174− | Reset
175− | Browse
176− | Load
177− | Foreign
178− | Type
179− | Kind
180− | Show
181− 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−163
@@ -1,163 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−{-# LANGUAGE TupleSections #-}
3−{-# LANGUAGE CPP #-}
4−
5−module Main where
6−
7−import Control.Monad.Trans.State.Strict (runStateT)
8−import Control.Monad (when, forM)
9−#if __GLASGOW_HASKELL__ < 710
10−import Control.Applicative
11−#endif
12−import Control.Monad.Writer.Strict (runWriterT)
13−import Control.Monad.Trans.Except (runExceptT)
14−
15−import Data.List (sort)
16−
17−import System.Exit (exitFailure)
18−import System.Console.Haskeline
19−import System.FilePath ((</>))
20−import System.Directory (getCurrentDirectory)
21−import qualified System.FilePath.Glob as Glob
22−
23−import Test.HUnit
24−
25−import qualified Language.PureScript as P
26−
27−import PSCi
28−import Completion
29−import Types
30−
31−import TestsSetup
32−
33−main :: IO ()
34−main = do
35− fetchSupportCode
36− Counts{..} <- runTestTT allTests
37− when (errors + failures > 0) exitFailure
38−
39−allTests :: Test
40−allTests = completionTests
41−
42−completionTests :: Test
43−completionTests =
44− TestLabel "completionTests"
45− (TestList (map (TestCase . assertCompletedOk) completionTestData))
46−
47−-- If the cursor is at the right end of the line, with the 1st element of the
48−-- pair as the text in the line, then pressing tab should offer all the
49−-- elements of the list (which is the 2nd element) as completions.
50−completionTestData :: [(String, [String])]
51−completionTestData =
52− -- basic directives
53− [ (":h", [":help"])
54− , (":re", [":reset"])
55− , (":q", [":quit"])
56− , (":mo", [":module"])
57− , (":b", [":browse"])
58−
59− -- :browse should complete module names
60− , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
61− , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
62−
63− -- import should complete module names
64− , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
65− , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
66− , ("import qualified Control.Monad.Eff.", map ("import qualified Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
67−
68− -- :load, :module should complete file paths
69− , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])
70− , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])
71−
72− -- :quit, :help, :reset should not complete
73− , (":help ", [])
74− , (":quit ", [])
75− , (":reset ", [])
76−
77− -- :show should complete to "loaded" and "import"
78− , (":show ", [":show import", ":show loaded"])
79− , (":show a", [])
80−
81− -- :type should complete values and data constructors in scope
82− , (":type Control.Monad.Eff.Console.lo", [":type Control.Monad.Eff.Console.log"])
83− , (":type uni", [":type unit"])
84− , (":type E", [":type EQ"])
85−
86− -- :kind should complete types in scope
87− , (":kind C", [":kind Control.Monad.Eff.Pure"])
88− , (":kind O", [":kind Ordering"])
89−
90− -- Only one argument for directives should be completed
91− , (":show import ", [])
92− , (":type EQ ", [])
93− , (":kind Ordering ", [])
94−
95− -- a few other import tests
96− , ("impor", ["import"])
97− , ("import q", ["import qualified"])
98− , ("import ", map ("import " ++) supportModules ++ ["import qualified"])
99− , ("import Prelude ", [])
100−
101− -- String and number literals should not be completed
102− , ("\"hi", [])
103− , ("34", [])
104−
105− -- Identifiers and data constructors should be completed
106− , ("uni", ["unit"])
107− , ("Control.Monad.Eff.Class.", ["Control.Monad.Eff.Class.liftEff"])
108− , ("G", ["GT"])
109− , ("Prelude.L", ["Prelude.LT"])
110−
111− -- if a module is imported qualified, values should complete under the
112− -- qualified name, as well as the original name.
113− , ("ST.new", ["ST.newSTRef"])
114− , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
115− ]
116− where
117−
118−assertCompletedOk :: (String, [String]) -> Assertion
119−assertCompletedOk (line, expecteds) = do
120− (unusedR, completions) <- runCM (completion' (reverse line, ""))
121− let unused = reverse unusedR
122− let actuals = map ((unused ++) . replacement) completions
123− sort expecteds @=? sort actuals
124−
125−runCM :: CompletionM a -> IO a
126−runCM act = do
127− psciState <- getPSCiState
128− fmap fst (runStateT (liftCompletionM act) psciState)
129−
130−getPSCiState :: IO PSCiState
131−getPSCiState = do
132− cwd <- getCurrentDirectory
133− let supportDir = cwd </> "tests" </> "support" </> "flattened"
134− let supportFiles ext = Glob.globDir1 (Glob.compile ("*." ++ ext)) supportDir
135− pursFiles <- supportFiles "purs"
136− jsFiles <- supportFiles "js"
137−
138− modulesOrFirstError <- loadAllModules pursFiles
139− foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)
140− Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
141− case modulesOrFirstError of
142− Left err ->
143− print err >> exitFailure
144− Right modules ->
145− let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
146− in return (PSCiState [] imports modules foreigns [] [])
147−
148−controlMonadSTasST :: ImportedModule
149−controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
150− where
151− s = P.moduleNameFromString
152−
153−supportModules :: [String]
154−supportModules =
155− [ "Control.Monad.Eff.Class"
156− , "Control.Monad.Eff.Console"
157− , "Control.Monad.Eff"
158− , "Control.Monad.Eff.Unsafe"
159− , "Control.Monad.ST"
160− , "Data.Function"
161− , "Prelude"
162− , "Test.Assert"
163− ]
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−312
@@ -1,312 +0,0 @@
1−name: purescript
2−version: 0.7.5
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− , pcc/include/*.hh
37−
38−source-repository head
39− type: git
40− location: https://github.com/purescript/purescript.git
41−
42−library
43− build-depends: base >=4.6 && <5,
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.18
73−
74− exposed-modules: Language.PureScript
75− Language.PureScript.AST
76− Language.PureScript.AST.Binders
77− Language.PureScript.AST.Declarations
78− Language.PureScript.AST.Operators
79− Language.PureScript.AST.SourcePos
80− Language.PureScript.AST.Traversals
81− Language.PureScript.AST.Exported
82− Language.PureScript.Bundle
83− Language.PureScript.Externs
84− Language.PureScript.CodeGen
85− Language.PureScript.CodeGen.JS
86− Language.PureScript.CodeGen.JS.AST
87− Language.PureScript.CodeGen.JS.Common
88− Language.PureScript.CodeGen.JS.Optimizer
89− Language.PureScript.CodeGen.JS.Optimizer.Blocks
90− Language.PureScript.CodeGen.JS.Optimizer.Common
91− Language.PureScript.CodeGen.JS.Optimizer.Inliner
92− Language.PureScript.CodeGen.JS.Optimizer.MagicDo
93− Language.PureScript.CodeGen.JS.Optimizer.TCO
94− Language.PureScript.CodeGen.JS.Optimizer.Unused
95−
96− Language.PureScript.CodeGen.Cpp
97− Language.PureScript.CodeGen.Cpp.AST
98− Language.PureScript.CodeGen.Cpp.Common
99− Language.PureScript.CodeGen.Cpp.File
100− Language.PureScript.CodeGen.Cpp.Optimizer
101− Language.PureScript.CodeGen.Cpp.Optimizer.Blocks
102− Language.PureScript.CodeGen.Cpp.Optimizer.Common
103− Language.PureScript.CodeGen.Cpp.Optimizer.Inliner
104− Language.PureScript.CodeGen.Cpp.Optimizer.MagicDo
105− Language.PureScript.CodeGen.Cpp.Optimizer.TCO
106− Language.PureScript.CodeGen.Cpp.Optimizer.Unused
107− Language.PureScript.CodeGen.Cpp.Types
108− Language.PureScript.Pretty.Cpp
109−
110− Language.PureScript.Constants
111− Language.PureScript.CoreFn
112− Language.PureScript.CoreFn.Ann
113− Language.PureScript.CoreFn.Binders
114− Language.PureScript.CoreFn.Desugar
115− Language.PureScript.CoreFn.Expr
116− Language.PureScript.CoreFn.Literals
117− Language.PureScript.CoreFn.Meta
118− Language.PureScript.CoreFn.Module
119− Language.PureScript.CoreFn.Traversals
120− Language.PureScript.Comments
121− Language.PureScript.Environment
122− Language.PureScript.Errors
123− Language.PureScript.Kinds
124− Language.PureScript.Linter
125− Language.PureScript.Linter.Exhaustive
126− Language.PureScript.Make
127− Language.PureScript.ModuleDependencies
128− Language.PureScript.Names
129− Language.PureScript.Options
130− Language.PureScript.Parser
131− Language.PureScript.Parser.Lexer
132− Language.PureScript.Parser.Common
133− Language.PureScript.Parser.Declarations
134− Language.PureScript.Parser.JS
135− Language.PureScript.Parser.Kinds
136− Language.PureScript.Parser.State
137− Language.PureScript.Parser.Types
138− Language.PureScript.Pretty
139− Language.PureScript.Pretty.Common
140− Language.PureScript.Pretty.JS
141− Language.PureScript.Pretty.Kinds
142− Language.PureScript.Pretty.Types
143− Language.PureScript.Pretty.Values
144− Language.PureScript.Renamer
145− Language.PureScript.Sugar
146− Language.PureScript.Sugar.BindingGroups
147− Language.PureScript.Sugar.CaseDeclarations
148− Language.PureScript.Sugar.DoNotation
149− Language.PureScript.Sugar.Names
150− Language.PureScript.Sugar.Names.Env
151− Language.PureScript.Sugar.Names.Imports
152− Language.PureScript.Sugar.Names.Exports
153− Language.PureScript.Sugar.ObjectWildcards
154− Language.PureScript.Sugar.Operators
155− Language.PureScript.Sugar.TypeClasses
156− Language.PureScript.Sugar.TypeClasses.Deriving
157− Language.PureScript.Sugar.TypeDeclarations
158− Language.PureScript.Traversals
159− Language.PureScript.TypeChecker
160− Language.PureScript.TypeChecker.Entailment
161− Language.PureScript.TypeChecker.Kinds
162− Language.PureScript.TypeChecker.Monad
163− Language.PureScript.TypeChecker.Rows
164− Language.PureScript.TypeChecker.Skolems
165− Language.PureScript.TypeChecker.Subsumption
166− Language.PureScript.TypeChecker.Synonyms
167− Language.PureScript.TypeChecker.Types
168− Language.PureScript.TypeChecker.Unify
169− Language.PureScript.TypeClassDictionaries
170− Language.PureScript.Types
171−
172− Language.PureScript.Docs
173− Language.PureScript.Docs.Convert
174− Language.PureScript.Docs.Render
175− Language.PureScript.Docs.Types
176− Language.PureScript.Docs.RenderedCode
177− Language.PureScript.Docs.RenderedCode.Types
178− Language.PureScript.Docs.RenderedCode.Render
179− Language.PureScript.Docs.AsMarkdown
180− Language.PureScript.Docs.ParseAndDesugar
181− Language.PureScript.Docs.Utils.MonoidExtras
182−
183− Language.PureScript.Publish
184− Language.PureScript.Publish.Utils
185− Language.PureScript.Publish.ErrorsWarnings
186− Language.PureScript.Publish.BoxesHelpers
187−
188− Control.Monad.Unify
189− Control.Monad.Supply
190− Control.Monad.Supply.Class
191−
192− System.IO.UTF8
193− exposed: True
194− buildable: True
195− hs-source-dirs: src
196− other-modules: Paths_purescript
197− ghc-options: -Wall -O2
198−
199−executable psc
200− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
201− mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
202− time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8
203− main-is: Main.hs
204− buildable: True
205− hs-source-dirs: psc
206− ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"
207−
208−executable psci
209− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
210− mtl -any, optparse-applicative >= 0.10.0, parsec -any,
211− haskeline >= 0.7.0.0, purescript -any, transformers -any,
212− transformers-compat -any, process -any, time -any, Glob -any
213−
214− main-is: Main.hs
215− buildable: True
216− hs-source-dirs: psci psci/main
217− other-modules: Types
218− Parser
219− Directive
220− Completion
221− PSCi
222− IO
223− ghc-options: -Wall -O2
224−
225−executable psc-docs
226− build-depends: base >=4 && <5, purescript -any,
227− optparse-applicative >= 0.10.0, process -any, mtl -any,
228− split -any, ansi-wl-pprint -any, directory -any,
229− filepath -any, Glob -any
230− main-is: Main.hs
231− buildable: True
232− hs-source-dirs: psc-docs
233− other-modules: Ctags
234− Etags
235− Tags
236− ghc-options: -Wall -O2
237−
238−executable psc-publish
239− build-depends: base >=4 && <5, purescript -any, bytestring -any, aeson -any, optparse-applicative -any
240− main-is: Main.hs
241− buildable: True
242− hs-source-dirs: psc-publish
243− ghc-options: -Wall -O2
244−
245−executable psc-hierarchy
246− build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
247− process -any, mtl -any, parsec -any, filepath -any, directory -any,
248− Glob -any
249− main-is: Main.hs
250− buildable: True
251− hs-source-dirs: hierarchy
252− other-modules:
253− ghc-options: -Wall -O2
254−
255−executable psc-bundle
256− main-is: Main.hs
257− other-modules:
258− other-extensions:
259− build-depends: base >=4 && <5,
260− purescript -any,
261− filepath -any,
262− directory -any,
263− mtl -any,
264− transformers -any,
265− transformers-compat -any,
266− optparse-applicative >= 0.10.0,
267− Glob -any
268− ghc-options: -Wall -O2
269− hs-source-dirs: psc-bundle
270−
271−executable pcc
272− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
273− file-embed >= 0.0.7 && < 0.0.8,
274− bytestring -any,
275− mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
276− time -any, transformers -any, transformers-compat -any
277− main-is: Main.hs
278− buildable: True
279− hs-source-dirs: pcc
280− other-modules:
281− ghc-options: -Wall -O2 -fno-warn-unused-do-bind
282−
283−test-suite tests
284− build-depends: base >=4 && <5, containers -any, directory -any,
285− filepath -any, mtl -any, parsec -any, purescript -any,
286− transformers -any, process -any, transformers-compat -any, time -any,
287− Glob -any
288− type: exitcode-stdio-1.0
289− main-is: Main.hs
290− other-modules: TestsSetup
291− buildable: True
292− hs-source-dirs: tests tests/common
293−
294−test-suite psci-tests
295− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
296− mtl -any, optparse-applicative >= 0.10.0, parsec -any,
297− haskeline >= 0.7.0.0, purescript -any, transformers -any,
298− transformers-compat -any, process -any, HUnit -any, time -any,
299− Glob -any
300− type: exitcode-stdio-1.0
301− main-is: Main.hs
302− other-modules: TestsSetup
303− buildable: True
304− hs-source-dirs: psci psci/tests tests/common
305− ghc-options: -Wall
306−
307−test-suite pcc-tests
308− build-depends: base >=4 && <5, directory -any, filepath -any, process -any
309− type: exitcode-stdio-1.0
310− main-is: TestMain.hs
311− buildable: True
312− hs-source-dirs: pcc
src/CodeGen/IL.hsnew file+321
@@ -0,0 +1,321 @@
1+-- | This module generates code in the core imperative representation from
2+-- elaborated PureScript code.
3+module CodeGen.IL
4+ ( module AST
5+ , module Common
6+ , moduleToIL
7+ ) where
8+
9+import Prelude.Compat
10+import Protolude (ordNub)
11+
12+import Control.Arrow ((&&&))
13+import Control.Monad (forM, liftM, replicateM, void)
14+import Control.Monad.Supply.Class
15+
16+import Data.List ((\\), delete, intersect, nub)
17+import qualified Data.Foldable as F
18+import qualified Data.Map as M
19+import Data.Maybe (fromMaybe, isNothing, mapMaybe)
20+import Data.Monoid ((<>))
21+import Data.String (fromString)
22+import Data.Text (Text)
23+import qualified Data.Text as T
24+
25+import Language.PureScript.AST.SourcePos
26+import Language.PureScript.CoreImp.AST (AST)
27+import qualified Language.PureScript.CoreImp.AST as AST
28+import Language.PureScript.CoreFn
29+import Language.PureScript.Crash
30+import Language.PureScript.Names
31+import Language.PureScript.Options
32+import Language.PureScript.PSString (PSString, mkString)
33+import Language.PureScript.Traversals (sndM)
34+import qualified Language.PureScript.Constants as C
35+
36+import System.FilePath.Posix ((</>))
37+
38+import CodeGen.IL.Common as Common
39+import CodeGen.IL.Optimizer
40+import CodeGen.IL.Printer
41+
42+data DeclType = ModuleDecl | LetDecl | RecLetDecl deriving (Eq)
43+
44+-- | Generate code in the simplified intermediate representation for all declarations in a
45+-- module.
46+moduleToIL
47+ :: forall m
48+ -- . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
49+ . (Monad m, MonadSupply m)
50+ => Module Ann
51+ -> Text
52+ -> m (Text, [Text], [AST], Text, Text)
53+moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
54+ do
55+ ilDecls <- mapM (bindToIL ModuleDecl) decls
56+ optimized <- traverse (traverse (optimize modName')) ilDecls
57+ let optimized' = concat optimized
58+ values = annotValue <$> optimized'
59+ foreigns' = moduleIdentToIL <$> foreigns
60+ interface = interfaceSource modName values foreigns
61+ imports = nub . concat $ importToIL <$> optimized'
62+ implHeader = implHeaderSource modName imports project
63+ implFooter = implFooterSource (runModuleName mn) foreigns
64+ return $ (interface, foreigns', optimized', implHeader, implFooter)
65+ where
66+ modName = moduleNameToIL mn
67+ modName' = AST.Var Nothing modName
68+
69+ annotValue :: AST -> (Text, Bool)
70+ annotValue (AST.Function _ (Just name) [] (AST.Block _ [AST.Return _ ret]))
71+ | isLiteral ret = (name, True)
72+ annotValue (AST.Function _ (Just name) [] _) = (name, False)
73+ annotValue _ = error "Unexpected top-level value form"
74+
75+ -- | Extracts all declaration names from a binding group.
76+ getNames :: Bind Ann -> [Ident]
77+ getNames (NonRec _ ident _) = [ident]
78+ getNames (Rec vals) = map (snd . fst) vals
79+
80+ -- | Generates IL code for a module import
81+ --
82+ importToIL :: AST -> [Text]
83+ importToIL = AST.everything (++) modRef
84+ where
85+ modRef (AST.Indexer _ (AST.Var _ _) (AST.Var _ mname))
86+ | not $ T.null mname = [extract mname]
87+ modRef _ = []
88+ extract :: Text -> Text
89+ extract = T.replace "_" "." . T.dropWhileEnd (=='_')
90+
91+ -- |
92+ -- Generate code in the simplified intermediate representation for a declaration
93+ --
94+ bindToIL :: DeclType -> Bind Ann -> m [AST]
95+ bindToIL dt (NonRec ann ident val) = return <$> nonRecToIL dt ann ident val
96+ bindToIL dt (Rec vals) = forM vals (uncurry . uncurry $ nonRecToIL dt')
97+ where
98+ dt' = if dt == LetDecl then RecLetDecl else dt
99+
100+ -- | Generate code in the simplified intermediate representation for a single non-recursive
101+ -- declaration.
102+ --
103+ -- The main purpose of this function is to handle code generation for comments.
104+ nonRecToIL :: DeclType -> Ann -> Ident -> Expr Ann -> m AST
105+ nonRecToIL dt a i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
106+ -- withoutComment <- asks optionsNoComments
107+ let withoutComment = False
108+ if withoutComment
109+ then nonRecToIL dt a i (modifyAnn removeComments e)
110+ else AST.Comment Nothing com <$> nonRecToIL dt a i (modifyAnn removeComments e)
111+ nonRecToIL ModuleDecl (ss, _, _, _) ident val = do
112+ il <- valueToIL val
113+ pure $ AST.Function Nothing (Just $ moduleIdentToIL ident) [] (AST.Block Nothing [AST.Return Nothing il])
114+ nonRecToIL RecLetDecl (ss, _, _, _) ident val = do
115+ ilExpr <- valueToIL val
116+ pure $ AST.Assignment Nothing (AST.Var Nothing $ identToIL ident) ilExpr
117+ nonRecToIL _ (ss, _, _, _) ident val = do
118+ il <- valueToIL val
119+ pure $ AST.VariableIntroduction Nothing (identToIL ident) (Just il)
120+
121+ -- | Generate code in the simplified intermediate representation for a variable based on a
122+ -- PureScript identifier.
123+ var :: Ident -> AST
124+ var = AST.Var Nothing . identToIL
125+
126+ accessorString :: PSString -> AST -> AST
127+ accessorString prop = AST.Indexer Nothing (AST.StringLiteral Nothing prop)
128+
129+ -- | Generate code in the simplified intermediate representation for a value or expression.
130+
131+ valueToIL :: Expr Ann -> m AST
132+ valueToIL (Literal (pos, _, _, _) l) = literalToValueIL pos l
133+ valueToIL (Accessor _ prop val) =
134+ accessorString prop <$> valueToIL val
135+ valueToIL (ObjectUpdate _ o ps) = do
136+ obj <- valueToIL o
137+ updates <- mapM (sndM valueToIL) ps
138+ obj' <- freshName'
139+ let objVar = AST.Var Nothing obj'
140+ copy = AST.VariableIntroduction Nothing obj' (Just $ copyDict obj)
141+ assign (k, v) = AST.Assignment Nothing (accessorString k objVar) v
142+ sts = copy : (assign <$> updates) ++ [AST.Return Nothing objVar]
143+ return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing sts)) []
144+ valueToIL (Abs _ arg val) = do
145+ ret <- valueToIL val
146+ let ilArg = case arg of
147+ UnusedIdent -> []
148+ _ -> [identToIL arg]
149+ return $ AST.Function Nothing Nothing ilArg (AST.Block Nothing [AST.Return Nothing ret])
150+ valueToIL e@App{} = do
151+ let (f, args) = unApp e []
152+ args' <- mapM valueToIL args
153+ fn <- valueToIL f
154+ case f of
155+ Var (_, _, _, Just IsNewtype) _ -> return (head args')
156+ _ -> flip (foldl (\fn a -> AST.App Nothing fn [a])) args' <$> valueToIL f
157+ where
158+ unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
159+ unApp (App _ val arg) args = unApp val (arg : args)
160+ unApp other args = (other, args)
161+ valueToIL (Var _ ident) = return $ varToIL ident
162+ valueToIL (Case (ss, _, _, _) values binders) = do
163+ vals <- mapM valueToIL values
164+ bindersToIL ss binders vals
165+ valueToIL (Let _ ds val) = do
166+ let recurs = concatMap getNames $ filter isRec ds
167+ recurDs = (\v -> AST.VariableIntroduction Nothing (identToIL v) Nothing) <$> recurs
168+ ds' <- concat <$> mapM (bindToIL LetDecl) ds
169+ ret <- valueToIL val
170+ return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (recurDs ++ ds' ++ [AST.Return Nothing ret]))) []
171+ where
172+ isRec :: Bind Ann -> Bool
173+ isRec (Rec _) = True
174+ isRec _ = False
175+ valueToIL (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) = error "IsNewtype"
176+ valueToIL (Constructor _ _ (ProperName ctor) fields) =
177+ let body = AST.ObjectLiteral Nothing $ (mkString ctor, AST.BooleanLiteral Nothing True) :
178+ ((\field -> (mkString (identToIL field), var field)) `map` fields)
179+ fn = foldr (\f inner -> AST.Function Nothing Nothing [identToIL f] (AST.Block Nothing [AST.Return Nothing inner])) body fields
180+ in return fn
181+
182+
183+ iife :: Text -> [AST] -> AST
184+ iife v exprs = AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing $ exprs ++ [AST.Return Nothing $ AST.Var Nothing v])) []
185+
186+ literalToValueIL :: SourceSpan -> Literal (Expr Ann) -> m AST
187+ literalToValueIL ss (NumericLiteral (Left i)) = return $ AST.NumericLiteral (Just ss) (Left i)
188+ literalToValueIL ss (NumericLiteral (Right n)) = return $ AST.NumericLiteral (Just ss) (Right n)
189+ literalToValueIL ss (StringLiteral s) = return $ AST.StringLiteral (Just ss) s
190+ literalToValueIL ss (CharLiteral c) = return $ AST.StringLiteral (Just ss) (fromString [c])
191+ literalToValueIL ss (BooleanLiteral b) = return $ AST.BooleanLiteral (Just ss) b
192+ literalToValueIL ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToIL xs
193+ literalToValueIL ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToIL) ps
194+
195+ -- | Generate code in the simplified intermediate representation for a reference to a
196+ -- variable.
197+ varToIL :: Qualified Ident -> AST
198+ varToIL (Qualified Nothing ident) = var ident
199+ varToIL qual = qualifiedToIL id qual
200+
201+ -- | Generate code in the simplified intermediate representation for a reference to a
202+ -- variable that may have a qualified name.
203+ qualifiedToIL :: (a -> Ident) -> Qualified a -> AST
204+ qualifiedToIL f (Qualified (Just (ModuleName mn')) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a
205+ qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))
206+ qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")
207+
208+ -- foreignIdent :: Ident -> AST
209+ -- foreignIdent ident = accessorString (mkString $ runIdent ident) (AST.Var Nothing "$foreign")
210+
211+ -- | Generate code in the simplified intermediate representation for pattern match binders
212+ -- and guards.
213+ bindersToIL :: SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST
214+ bindersToIL ss binders vals = do
215+ valNames <- replicateM (length vals) freshName'
216+ let assignments = zipWith (AST.VariableIntroduction Nothing) valNames (map Just vals)
217+ ils <- forM binders $ \(CaseAlternative bs result) -> do
218+ ret <- guardsToIL result
219+ go valNames ret bs
220+ return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (assignments ++ concat ils ++ [AST.Throw Nothing (AST.StringLiteral Nothing $ mkString failedPatternMessage)])))
221+ []
222+ where
223+ go :: [Text] -> [AST] -> [Binder Ann] -> m [AST]
224+ go _ done [] = return done
225+ go (v:vs) done' (b:bs) = do
226+ done'' <- go vs done' bs
227+ binderToIL v done'' b
228+ go _ _ _ = internalError "Invalid arguments to bindersToIL"
229+
230+ failedPatternMessage :: Text
231+ failedPatternMessage = "Failed pattern match at " <> runModuleName mn <> " " <> displayStartEndPos ss
232+
233+ guardsToIL :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [AST]
234+ guardsToIL (Left gs) = traverse genGuard gs where
235+ genGuard (cond, val) = do
236+ cond' <- valueToIL cond
237+ val' <- valueToIL val
238+ return
239+ (AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo cond' (AST.BooleanLiteral Nothing True))
240+ (AST.Block Nothing [AST.Return Nothing val']) Nothing)
241+
242+ guardsToIL (Right v) = return . AST.Return Nothing <$> valueToIL v
243+
244+ -- | Generate code in the simplified intermediate representation for a pattern match
245+ -- binder.
246+ binderToIL :: Text -> [AST] -> Binder Ann -> m [AST]
247+ binderToIL _ done NullBinder{} = return done
248+ binderToIL varName done (LiteralBinder _ l) =
249+ literalToBinderIL varName done l
250+ binderToIL varName done (VarBinder _ ident) =
251+ return (AST.VariableIntroduction Nothing (identToIL ident) (Just (AST.Var Nothing varName)) : done)
252+ binderToIL varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
253+ binderToIL varName done b
254+ binderToIL varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ (Qualified _ (ProperName ctor)) bs) = do
255+ il <- go (zip fields bs) done
256+ return $ case ctorType of
257+ ProductType -> il
258+ SumType ->
259+ [AST.IfElse Nothing (AST.InstanceOf Nothing (AST.Var Nothing varName) (AST.StringLiteral Nothing (mkString ctor)))
260+ (AST.Block Nothing il)
261+ Nothing]
262+ where
263+ go :: [(Ident, Binder Ann)] -> [AST] -> m [AST]
264+ go [] done' = return done'
265+ go ((field, binder) : remain) done' = do
266+ argVar <- freshName'
267+ done'' <- go remain done'
268+ il <- binderToIL argVar done'' binder
269+ return (AST.VariableIntroduction Nothing argVar (Just $ accessorString (mkString $ identToIL field) $ AST.Var Nothing varName) : il)
270+
271+ binderToIL _ _ ConstructorBinder{} =
272+ internalError "binderToIL: Invalid ConstructorBinder in binderToIL"
273+ binderToIL varName done (NamedBinder _ ident binder) = do
274+ il <- binderToIL varName done binder
275+ return (AST.VariableIntroduction Nothing (identToIL ident) (Just (AST.Var Nothing varName)) : il)
276+
277+ literalToBinderIL :: Text -> [AST] -> Literal (Binder Ann) -> m [AST]
278+ literalToBinderIL varName done (NumericLiteral num) =
279+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.NumericLiteral Nothing num)) (AST.Block Nothing done) Nothing]
280+ literalToBinderIL varName done (CharLiteral c) =
281+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing (fromString [c]))) (AST.Block Nothing done) Nothing]
282+ literalToBinderIL varName done (StringLiteral str) =
283+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing str)) (AST.Block Nothing done) Nothing]
284+ literalToBinderIL varName done (BooleanLiteral True) =
285+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.BooleanLiteral Nothing True)) (AST.Block Nothing done) Nothing]
286+ literalToBinderIL varName done (BooleanLiteral False) =
287+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.BooleanLiteral Nothing False)) (AST.Block Nothing done) Nothing]
288+ -- return [AST.IfElse Nothing (AST.Unary Nothing AST.Not (AST.Var Nothing varName)) (AST.Block Nothing done) Nothing]
289+ literalToBinderIL varName done (ObjectLiteral bs) = go done bs
290+ where
291+ go :: [AST] -> [(PSString, Binder Ann)] -> m [AST]
292+ go done' [] = return done'
293+ go done' ((prop, binder):bs') = do
294+ propVar <- freshName'
295+ done'' <- go done' bs'
296+ il <- binderToIL propVar done'' binder
297+ return (AST.VariableIntroduction Nothing propVar (Just (accessorString prop (AST.Var Nothing varName))) : il)
298+ literalToBinderIL varName done (ArrayLiteral bs) = do
299+ il <- go done 0 bs
300+ return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo
301+ (arrayLength $ AST.Var Nothing varName)
302+ (AST.NumericLiteral Nothing (Left (fromIntegral $ length bs))))
303+ (AST.Block Nothing il) Nothing]
304+ where
305+ go :: [AST] -> Integer -> [Binder Ann] -> m [AST]
306+ go done' _ [] = return done'
307+ go done' index (binder:bs') = do
308+ elVar <- freshName'
309+ done'' <- go done' (index + 1) bs'
310+ il <- binderToIL elVar done'' binder
311+ return (AST.VariableIntroduction Nothing elVar (Just (AST.Indexer Nothing (AST.NumericLiteral Nothing (Left index)) (AST.Var Nothing varName))) : il)
312+
313+emptyAnn :: Ann
314+emptyAnn = (SourceSpan "" (SourcePos 0 0) (SourcePos 0 0), [], Nothing, Nothing)
315+
316+arrayLength :: AST -> AST
317+arrayLength a = AST.App Nothing (AST.Var Nothing arrayLengthFn) [a]
318+-- arrayLength a = AST.Var Nothing (arrayLengthFn <> "(" <> prettyPrintIL1 a <> ")")
319+
320+copyDict :: AST -> AST
321+copyDict a = AST.App Nothing (AST.Var Nothing copyDictFn) [a]
src/CodeGen/IL/Common.hsnew file+196
@@ -0,0 +1,196 @@
1+-- | Common code generation utility functions
2+module CodeGen.IL.Common where
3+
4+import Prelude.Compat
5+
6+import Control.Monad.Supply.Class (MonadSupply, freshName)
7+import Data.Char
8+import Data.Maybe (maybe)
9+import Data.Monoid ((<>))
10+import Data.Text (Text)
11+import qualified Data.Text as T
12+
13+import Language.PureScript.Crash
14+import Language.PureScript.Names
15+
16+import qualified Language.PureScript.Constants as C
17+
18+moduleNameToIL :: ModuleName -> Text
19+moduleNameToIL (ModuleName mn) =
20+ let name = T.replace "." "_" mn
21+ in if nameIsILBuiltIn name then (name <> moduleRenamerMarker) else name
22+
23+moduleNameToIL' :: ModuleName -> Text
24+moduleNameToIL' (ModuleName mn) = T.replace "_" "." mn
25+
26+-- | Convert an 'Ident' into a valid IL identifier:
27+--
28+-- * Alphanumeric characters are kept unmodified.
29+--
30+-- * Reserved IL identifiers are wrapped with '_'.
31+--
32+identToIL :: Ident -> Text
33+identToIL UnusedIdent = unusedName
34+identToIL (Ident "$__unused") = unusedName
35+identToIL (Ident name) | name == C.undefined = undefinedName -- Note: done in Printer.hs too
36+identToIL (Ident name) = properToIL name
37+identToIL (GenIdent _ _) = internalError "GenIdent in identToIL"
38+
39+moduleIdentToIL :: Ident -> Text
40+moduleIdentToIL UnusedIdent = unusedName
41+moduleIdentToIL (Ident name) | name == C.undefined = undefinedName
42+moduleIdentToIL (Ident name) = moduleProperToIL name
43+moduleIdentToIL (GenIdent _ _) = internalError "GenIdent in identToIL"
44+
45+undefinedName :: Text
46+undefinedName = "Undefined"
47+
48+unusedName :: Text
49+unusedName = "_"
50+
51+properToIL :: Text -> Text
52+properToIL name
53+ | nameIsILReserved name = "ˉ" <> name
54+ | otherwise = T.concatMap identCharToText name
55+
56+-- | Attempts to find a human-readable name for a symbol, if none has been specified returns the
57+-- ordinal value.
58+identCharToText :: Char -> Text
59+identCharToText 'ṩ' = "_ṩ"
60+identCharToText c | isAlphaNum c = T.singleton c
61+identCharToText '_' = "_"
62+identCharToText '\'' = "ꞌ" -- lowercase saltillo
63+identCharToText c = error (show (ord c)) -- TODO: should never occur now(?)
64+
65+moduleProperToIL :: Text -> Text
66+moduleProperToIL = T.concatMap identCharToText
67+
68+-- | Checks whether an identifier name is reserved in IL.
69+nameIsILReserved :: Text -> Bool
70+nameIsILReserved name =
71+ name `elem` ilAnyReserved
72+
73+-- | Checks whether a name matches a built-in value in IL.
74+nameIsILBuiltIn :: Text -> Bool
75+nameIsILBuiltIn name =
76+ name `elem`
77+ [ "Any"
78+ , "Apply"
79+ , "Contains"
80+ , "CopyDict"
81+ , "Dict"
82+ , "EffFn"
83+ , "Fn"
84+ , "Foreign"
85+ , "Get"
86+ , "Index"
87+ , "Is"
88+ , "Length"
89+ , "Once"
90+ , "Run"
91+ , "Undefined"
92+ ]
93+
94+ilAnyReserved :: [Text]
95+ilAnyReserved =
96+ concat
97+ [ ilKeywords
98+ , ilLiterals
99+ ]
100+
101+ilKeywords :: [Text]
102+ilKeywords =
103+ [ "break"
104+ , "case"
105+ , "chan"
106+ , "const"
107+ , "continue"
108+ , "default"
109+ , "defer"
110+ , "else"
111+ , "fallthrough"
112+ , "for"
113+ , "func"
114+ , "go"
115+ , "goto"
116+ , "if"
117+ , "import"
118+ , "interface"
119+ , "map"
120+ , "package"
121+ , "range"
122+ , "return"
123+ , "select"
124+ , "struct"
125+ , "switch"
126+ , "type"
127+ , "var"
128+ ]
129+
130+ilLiterals :: [Text]
131+ilLiterals =
132+ [ "init"
133+ , "nil"
134+ , "int"
135+ , "int8"
136+ , "int16"
137+ , "int32"
138+ , "int64"
139+ , "uint"
140+ , "uint8"
141+ , "uint16"
142+ , "uint32"
143+ , "uint64"
144+ , "uintptr"
145+ , "float32"
146+ , "float64"
147+ , "complex64"
148+ , "complex128"
149+ , "byte"
150+ , "rune"
151+ , "string"
152+ ]
153+
154+withPrefix :: Text -> Text
155+withPrefix s = "Ꞌ" <> s -- uppercase saltillo
156+
157+anyType :: Text
158+anyType = "Any"
159+
160+dictType :: Text
161+dictType = "Dict"
162+
163+arrayType :: Text
164+arrayType = "[]" <> anyType
165+
166+uncurriedFnType :: Int -> Text
167+uncurriedFnType i = "Fn" <> (T.pack . show $ i)
168+
169+int :: Text
170+int = "int"
171+
172+float :: Text
173+float = "float64"
174+
175+bool :: Text
176+bool = "bool"
177+
178+string :: Text
179+string = "string"
180+
181+arrayLengthFn :: Text
182+arrayLengthFn = "Length"
183+
184+indexFn :: Text
185+indexFn = "Index"
186+
187+copyDictFn :: Text
188+copyDictFn = "CopyDict"
189+
190+freshName' :: MonadSupply m => m Text
191+freshName' = do
192+ name <- freshName
193+ return $ T.replace "$" "ṩ" name
194+
195+moduleRenamerMarker :: Text
196+moduleRenamerMarker = "__"
src/CodeGen/IL/Optimizer.hsnew file+81
@@ -0,0 +1,81 @@
1+-- | This module optimizes code in the intermediate representation.
2+module CodeGen.IL.Optimizer (optimize) where
3+
4+import Prelude.Compat
5+
6+import Control.Monad.Supply.Class (MonadSupply)
7+import Data.Text (Text)
8+import Language.PureScript.CoreImp.AST
9+import Language.PureScript.CoreImp.Optimizer.Blocks
10+import Language.PureScript.CoreImp.Optimizer.Common hiding (isDict)
11+import Language.PureScript.CoreImp.Optimizer.Inliner (etaConvert, evaluateIifes, inlineVariables, unThunk)
12+import Language.PureScript.CoreImp.Optimizer.Unused
13+
14+import CodeGen.IL.Common (unusedName)
15+import CodeGen.IL.Optimizer.Inliner
16+import CodeGen.IL.Optimizer.MagicDo
17+import CodeGen.IL.Optimizer.TCO
18+
19+import qualified Language.PureScript.Constants as C
20+
21+-- | Apply a series of optimizer passes to simplified IL code
22+optimize :: MonadSupply m => AST -> AST -> m AST
23+optimize mn il = do
24+ il' <- untilFixedPoint (inlineFnComposition . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp) il
25+ il'' <- untilFixedPoint (return . ignoreUnusedResults . inlineCommonValues . inlineCommonOperators . tidyUp) . tco mn . inlineST
26+ =<< untilFixedPoint (return . magicDoST)
27+ =<< untilFixedPoint (return . magicDoEff)
28+ =<< untilFixedPoint (return . magicDoEffect) il'
29+ untilFixedPoint (return . collapseVarDeclarations) il''
30+ where
31+ tidyUp :: AST -> AST
32+ tidyUp = applyAll
33+ [ collapseNestedBlocks
34+ , collapseNestedIfs
35+ , collapseIfChecks
36+ , removeCodeAfterReturnStatements
37+ , unThunk
38+ , etaConvert
39+ , evaluateIifes
40+ , inlineVariables
41+ ]
42+
43+untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
44+untilFixedPoint f = go
45+ where
46+ go a = do
47+ a' <- f a
48+ if a' == a then return a' else go a'
49+
50+collapseIfChecks :: AST -> AST
51+collapseIfChecks = everywhere collapse where
52+ collapse :: AST -> AST
53+ collapse (IfElse _ (Binary _ EqualTo (BooleanLiteral _ True) (BooleanLiteral _ True)) (Block _ [exprs]) _) = exprs
54+ collapse (IfElse _ (Binary _ EqualTo (Indexer _ (Var _ prop) (Var _ val)) (BooleanLiteral _ True)) (Block _ [exprs]) _)
55+ | prop == "otherwise" && val == "Data_Boolean" = exprs
56+ collapse exprs = exprs
57+
58+collapseVarDeclarations :: AST -> AST
59+collapseVarDeclarations = everywhere collapse where
60+ collapse :: AST -> AST
61+ collapse (Block ss sts) = Block ss (go Nothing sts)
62+ collapse s = s
63+
64+ go :: Maybe Text -> [AST] -> [AST]
65+ go _ [] = []
66+ go Nothing (decl@(VariableIntroduction _ var (Just _)) : sts) = decl : go (Just var) (go Nothing sts)
67+ go (Just var') ((VariableIntroduction ss var (Just val)) : sts)
68+ | var == var' = (Assignment ss (Var Nothing var) val) : go (Just var') sts
69+ go var' (s:sts) = s : go var' sts
70+
71+ignoreUnusedResults :: AST -> AST
72+ignoreUnusedResults = everywhere $ removeFromBlock go
73+ where
74+ go :: [AST] -> [AST]
75+ go [] = []
76+ go (VariableIntroduction ss var (Just s) : sts)
77+ | not $ any (everything (||) (isUsed var)) sts = sts'
78+ where
79+ sts' | App{} <- s = s : (go sts)
80+ | otherwise = go sts
81+ go (s:sts) = s : go sts
src/CodeGen/IL/Optimizer/Common.hsnew file+18
@@ -0,0 +1,18 @@
1+-- | Common functions used by the various optimizer phases
2+module CodeGen.IL.Optimizer.Common where
3+
4+import Prelude.Compat
5+
6+import Data.Text (Text)
7+
8+import Language.PureScript.CoreImp.AST
9+import Language.PureScript.PSString (PSString, decodeString)
10+
11+isDict :: (Text, PSString) -> AST -> Bool
12+isDict (moduleName, dictName) (Indexer _ (Var _ x) (Var _ y)) =
13+ Just x == decodeString dictName && y == moduleName
14+isDict _ _ = False
15+
16+isDict' :: [(Text, PSString)] -> AST -> Bool
17+isDict' xs il = any (`isDict` il) xs
18+
src/CodeGen/IL/Optimizer/Inliner.hsnew file+435
@@ -0,0 +1,435 @@
1+-- | This module performs basic inlining of known functions
2+module CodeGen.IL.Optimizer.Inliner
3+ ( inlineCommonValues
4+ , inlineCommonOperators
5+ , inlineFnComposition
6+ , inlineUnsafeCoerce
7+ , inlineUnsafePartial
8+ ) where
9+
10+import Prelude.Compat
11+
12+import Control.Monad.Supply.Class (MonadSupply)
13+
14+import Data.Either (rights)
15+import Data.Maybe (fromMaybe)
16+import Data.String (IsString, fromString)
17+import Data.Text (Text)
18+import qualified Data.Text as T
19+
20+import Language.PureScript.PSString (PSString, decodeString, mkString)
21+import Language.PureScript.CoreImp.AST
22+import Language.PureScript.CoreImp.Optimizer.Common hiding (isDict, isDict')
23+import Language.PureScript.AST (SourceSpan(..))
24+import qualified Language.PureScript.Constants as C
25+
26+import CodeGen.IL.Common
27+import CodeGen.IL.Optimizer.Common
28+
29+-- TODO: Potential bug:
30+-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
31+-- Needs to be: { 0..toFixed(10); }
32+-- Probably needs to be fixed in pretty-printer instead.
33+shouldInline :: AST -> Bool
34+shouldInline (Var _ _) = True
35+shouldInline (NumericLiteral _ _) = True
36+shouldInline (StringLiteral _ _) = True
37+shouldInline (BooleanLiteral _ _) = True
38+shouldInline (Indexer _ index val) = shouldInline index && shouldInline val
39+shouldInline _ = False
40+
41+inlineCommonValues :: AST -> AST
42+inlineCommonValues = everywhere convert
43+ where
44+ convert :: AST -> AST
45+ convert (App ss fn [dict])
46+ | isDict' [semiringNumber, semiringInt] dict && isDict fnZero fn = NumericLiteral ss (Left 0)
47+ | isDict' [semiringNumber, semiringInt] dict && isDict fnOne fn = NumericLiteral ss (Left 1)
48+ | isDict boundedBoolean dict && isDict fnBottom fn = BooleanLiteral ss False
49+ | isDict boundedBoolean dict && isDict fnTop fn = BooleanLiteral ss True
50+ convert (App ss (App _ fn [dict]) [x])
51+ | isDict ringInt dict && isDict fnNegate fn = Unary ss Negate (unbox x $ snd ringInt)
52+ convert (App ss (App _ (App _ fn [dict]) [x]) [y])
53+ | isDict semiringInt dict && isDict fnAdd fn = intOp ss Add semiringInt x y
54+ | isDict semiringInt dict && isDict fnMultiply fn = intOp ss Multiply semiringInt x y
55+ | isDict ringInt dict && isDict fnSubtract fn = intOp ss Subtract ringInt x y
56+ convert other = other
57+ fnZero = (C.dataSemiring, C.zero)
58+ fnOne = (C.dataSemiring, C.one)
59+ fnBottom = (C.dataBounded, C.bottom)
60+ fnTop = (C.dataBounded, C.top)
61+ fnAdd = (C.dataSemiring, C.add)
62+ fnMultiply = (C.dataSemiring, C.mul)
63+ fnSubtract = (C.dataRing, C.sub)
64+ fnNegate = (C.dataRing, C.negate)
65+ intOp ss op (_, d) x y = Binary ss op (unbox x d) (unbox y d)
66+
67+inlineCommonOperators :: AST -> AST
68+inlineCommonOperators = everywhereTopDown $ applyAll $
69+ [ binary semiringNumber opAdd Add
70+ , binary semiringNumber opMul Multiply
71+
72+ , binary ringNumber opSub Subtract
73+ , unary ringNumber opNegate Negate
74+
75+ , binary euclideanRingNumber opDiv Divide
76+
77+ -- , binary eqNumber opEq EqualTo
78+ -- , binary eqNumber opNotEq NotEqualTo
79+ , binary eqInt opEq EqualTo
80+ , binary eqInt opNotEq NotEqualTo
81+ , binary eqString opEq EqualTo
82+ , binary eqString opNotEq NotEqualTo
83+ , binary eqChar opEq EqualTo
84+ , binary eqChar opNotEq NotEqualTo
85+ , binary eqBoolean opEq EqualTo
86+ , binary eqBoolean opNotEq NotEqualTo
87+
88+ , binary ordBoolean opLessThan LessThan
89+ , binary ordBoolean opLessThanOrEq LessThanOrEqualTo
90+ , binary ordBoolean opGreaterThan GreaterThan
91+ , binary ordBoolean opGreaterThanOrEq GreaterThanOrEqualTo
92+ , binary ordChar opLessThan LessThan
93+ , binary ordChar opLessThanOrEq LessThanOrEqualTo
94+ , binary ordChar opGreaterThan GreaterThan
95+ , binary ordChar opGreaterThanOrEq GreaterThanOrEqualTo
96+ , binary ordInt opLessThan LessThan
97+ , binary ordInt opLessThanOrEq LessThanOrEqualTo
98+ , binary ordInt opGreaterThan GreaterThan
99+ , binary ordInt opGreaterThanOrEq GreaterThanOrEqualTo
100+ , binary ordNumber opLessThan LessThan
101+ , binary ordNumber opLessThanOrEq LessThanOrEqualTo
102+ , binary ordNumber opGreaterThan GreaterThan
103+ , binary ordNumber opGreaterThanOrEq GreaterThanOrEqualTo
104+ , binary ordString opLessThan LessThan
105+ , binary ordString opLessThanOrEq LessThanOrEqualTo
106+ , binary ordString opGreaterThan GreaterThan
107+ , binary ordString opGreaterThanOrEq GreaterThanOrEqualTo
108+
109+ , binary semigroupString opAppend Add
110+
111+ , binary heytingAlgebraBoolean opConj And
112+ , binary heytingAlgebraBoolean opDisj Or
113+ , unary heytingAlgebraBoolean opNot Not
114+
115+ , binary' C.dataIntBits C.or BitwiseOr
116+ , binary' C.dataIntBits C.and BitwiseAnd
117+ , binary' C.dataIntBits C.xor BitwiseXor
118+ , binary' C.dataIntBits C.shl ShiftLeft
119+ , binary' C.dataIntBits C.shr ShiftRight
120+ , unary' C.dataIntBits C.complement BitwiseNot
121+
122+ , inlineNonClassFunction (isModFn (C.dataFunction, C.apply)) $ \f x -> App Nothing f [x]
123+ , inlineNonClassFunction (isModFn (C.dataFunction, C.applyFlipped)) $ \x f -> App Nothing f [x]
124+ , inlineUnsafeIndex (isModFnWithDict (C.dataArray, C.unsafeIndex)) $ flip (Indexer Nothing)
125+ ] ++
126+ [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ] ++
127+ [ fn | i <- [0..10], fn <- [ mkEffFn C.controlMonadEffUncurried C.mkEffFn i, runEffFn C.controlMonadEffUncurried C.runEffFn i ] ] ++
128+ [ fn | i <- [0..10], fn <- [ mkEffFn C.effectUncurried C.mkEffectFn i, runEffFn C.effectUncurried C.runEffectFn i ] ]
129+ where
130+ binary :: (Text, PSString) -> (Text, PSString) -> BinaryOperator -> AST -> AST
131+ binary dict@(_, d) fns op = convert where
132+ convert :: AST -> AST
133+ convert (App ss (App _ (App _ fn [dict']) [x]) [y])
134+ | isDict dict dict' && isDict fns fn = Binary ss op (unbox x d) (unbox y d)
135+ convert other = other
136+ binary' :: Text -> PSString -> BinaryOperator -> AST -> AST
137+ binary' moduleName opString op = convert where
138+ convert :: AST -> AST
139+ convert (App ss (App _ fn [x]) [y]) | isDict (moduleName, opString) fn = Binary ss op (unbox x mn) (unbox y mn)
140+ convert other = other
141+ mn :: PSString
142+ mn = mkString moduleName
143+ unary :: (Text, PSString) -> (Text, PSString) -> UnaryOperator -> AST -> AST
144+ unary dicts@(_, d) fns op = convert where
145+ convert :: AST -> AST
146+ convert (App ss (App _ fn [dict']) [x]) | isDict dicts dict' && isDict fns fn = Unary ss op (unbox x d)
147+ convert other = other
148+ unary' :: Text -> PSString -> UnaryOperator -> AST -> AST
149+ unary' moduleName fnName op = convert where
150+ convert :: AST -> AST
151+ convert (App ss fn [x]) | isDict (moduleName, fnName) fn = Unary ss op (unbox x fnName)
152+ convert other = other
153+
154+ mkFn :: Int -> AST -> AST
155+ mkFn = mkFn' C.dataFunctionUncurried C.mkFn $ \ss1 ss2 ss3 args il ->
156+ Function ss1 Nothing args (Block ss2 [Return ss3 il])
157+
158+ mkEffFn :: Text -> Text -> Int -> AST -> AST
159+ mkEffFn modName fnName = mkFn' modName fnName $ \ss1 ss2 ss3 args il ->
160+ Function ss1 Nothing args (Block ss2 [Return ss3 (App ss3 il [])])
161+
162+ mkFn' :: Text -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST
163+ mkFn' modName fnName res 0 = convert where
164+ convert :: AST -> AST
165+ convert (App _ mkFnN [Function s1 Nothing [_] (Block s2 [Return s3 il])]) | isNFn modName fnName 0 mkFnN =
166+ res s1 s2 s3 [] il
167+ convert other = other
168+ mkFn' modName fnName res n = convert where
169+ convert :: AST -> AST
170+ convert orig@(App ss mkFnN [fn]) | isNFn modName fnName n mkFnN =
171+ case collectArgs n [] fn of
172+ Just (args, [Return ss' ret]) -> res ss ss ss' args ret
173+ _ -> orig
174+ convert other = other
175+ collectArgs :: Int -> [Text] -> AST -> Maybe ([Text], [AST])
176+ collectArgs 1 acc (Function _ Nothing [oneArg] (Block _ il)) | length acc == n - 1 = Just (reverse (oneArg : acc), il)
177+ collectArgs m acc (Function _ Nothing [oneArg] (Block _ [Return _ ret])) = collectArgs (m - 1) (oneArg : acc) ret
178+ collectArgs _ _ _ = Nothing
179+
180+ isNFn :: Text -> Text -> Int -> AST -> Bool
181+ isNFn expectMod prefix n (Indexer _ (Var _ name) (Var _ modName)) | modName == expectMod =
182+ name == fromString (T.unpack prefix <> show n)
183+ isNFn _ _ _ _ = False
184+
185+ runFn :: Int -> AST -> AST
186+ runFn = runFn' C.dataFunctionUncurried C.runFn (\ss f args ->
187+ let len = length args
188+ typ = mkString $ uncurriedFnType len in
189+ if len > 0
190+ then App ss (App Nothing (StringLiteral Nothing typ) [f]) args
191+ else App ss f args)
192+ runEffFn :: Text -> Text -> Int -> AST -> AST
193+ runEffFn modName fnName = runFn' modName fnName $ \ss fn acc ->
194+ let typ = mkString . uncurriedFnType $ length acc in
195+ Function ss Nothing [] (Block ss [Return ss (App ss (App Nothing (StringLiteral Nothing typ) [fn]) acc)])
196+
197+ runFn' :: Text -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
198+ runFn' modName runFnName res n = convert where
199+ convert :: AST -> AST
200+ convert il = fromMaybe il $ go n [] il
201+
202+ go :: Int -> [AST] -> AST -> Maybe AST
203+ go 0 acc (App ss runFnN [fn]) | isNFn modName runFnName n runFnN && length acc == n =
204+ Just $ res ss fn acc
205+ go m acc (App _ lhs [arg]) = go (m - 1) (arg : acc) lhs
206+ go _ _ _ = Nothing
207+
208+ inlineNonClassFunction :: (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
209+ inlineNonClassFunction p f = convert where
210+ convert :: AST -> AST
211+ convert (App _ (App _ op' [x]) [y]) | p op' = f x y
212+ convert other = other
213+
214+ inlineUnsafeIndex :: (AST -> Bool) -> (AST -> AST -> AST) -> AST -> AST
215+ inlineUnsafeIndex p _ = convert where
216+ convert :: AST -> AST
217+ convert (App _ (App ss op' [x]) [y@NumericLiteral{}])
218+ | p op' = Indexer ss y x
219+ convert (App _ (App ss op' [x]) [y])
220+ | p op' = App ss (Var Nothing indexFn) [x, y]
221+ convert other = other
222+
223+ isModFn :: (Text, PSString) -> AST -> Bool
224+ isModFn (m, op) (Indexer _ (Var _ op') (Var _ m')) =
225+ m == m' && decodeString op == Just op'
226+ isModFn _ _ = False
227+
228+ isModFnWithDict :: (Text, PSString) -> AST -> Bool
229+ isModFnWithDict (m, op) (App _ (Indexer _ (Var _ op') (Var _ m')) [Var _ _]) =
230+ m == m' && decodeString op == Just op'
231+ isModFnWithDict _ _ = False
232+
233+-- (f <<< g $ x) = f (g x)
234+-- (f <<< g) = \x -> f (g x)
235+inlineFnComposition :: forall m. MonadSupply m => AST -> m AST
236+inlineFnComposition = everywhereTopDownM convert where
237+ convert :: AST -> m AST
238+ convert (App s1 (App s2 (App _ (App _ fn [dict']) [x]) [y]) [z])
239+ | isFnCompose dict' fn = return $ App s1 x [App s2 y [z]]
240+ | isFnComposeFlipped dict' fn = return $ App s2 y [App s1 x [z]]
241+ convert app@(App ss (App _ (App _ fn [dict']) _) _)
242+ | isFnCompose dict' fn || isFnComposeFlipped dict' fn = mkApps ss <$> goApps app <*> freshName'
243+ convert other = return other
244+
245+ mkApps :: Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST
246+ mkApps ss fns a = App ss (Function ss Nothing [] (Block ss $ vars <> [Return Nothing comp])) []
247+ where
248+ vars = uncurry (VariableIntroduction ss) . fmap Just <$> rights fns
249+ comp = Function ss Nothing [a] (Block ss [Return Nothing apps])
250+ apps = foldr (\fn acc -> App ss (mkApp fn) [acc]) (Var ss a) fns
251+
252+ mkApp :: Either AST (Text, AST) -> AST
253+ mkApp = either id $ \(name, arg) -> Var (getSourceSpan arg) name
254+
255+ goApps :: AST -> m [Either AST (Text, AST)]
256+ goApps (App _ (App _ (App _ fn [dict']) [x]) [y])
257+ | isFnCompose dict' fn = mappend <$> goApps x <*> goApps y
258+ | isFnComposeFlipped dict' fn = mappend <$> goApps y <*> goApps x
259+ goApps app@(App {}) = pure . Right . (,app) <$> freshName'
260+ goApps other = pure [Left other]
261+
262+ isFnCompose :: AST -> AST -> Bool
263+ isFnCompose dict' fn = isDict semigroupoidFn dict' && isDict fnCompose fn
264+
265+ isFnComposeFlipped :: AST -> AST -> Bool
266+ isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isDict fnComposeFlipped fn
267+
268+ fnCompose :: forall a b. (IsString a, IsString b) => (a, b)
269+ fnCompose = (C.controlSemigroupoid, C.compose)
270+
271+ fnComposeFlipped :: forall a b. (IsString a, IsString b) => (a, b)
272+ fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)
273+
274+inlineUnsafeCoerce :: AST -> AST
275+inlineUnsafeCoerce = everywhereTopDown convert where
276+ convert (App _ (Indexer _ (Var _ unsafeCoerceFn) (Var _ unsafeCoerce)) [ comp ])
277+ | unsafeCoerceFn == C.unsafeCoerceFn && unsafeCoerce == C.unsafeCoerce
278+ = comp
279+ convert other = other
280+
281+inlineUnsafePartial :: AST -> AST
282+inlineUnsafePartial = everywhereTopDown convert where
283+ convert (App ss fn [ comp ])
284+ | isDict fnUnsafePartial fn
285+ = App ss comp []
286+ where
287+ fnUnsafePartial :: forall a b. (IsString a, IsString b) => (a, b)
288+ fnUnsafePartial = (C.partialUnsafe, C.unsafePartial)
289+ convert other = other
290+
291+semiringNumber :: forall a b. (IsString a, IsString b) => (a, b)
292+semiringNumber = (C.dataSemiring, C.semiringNumber)
293+
294+semiringInt :: forall a b. (IsString a, IsString b) => (a, b)
295+semiringInt = (C.dataSemiring, C.semiringInt)
296+
297+ringNumber :: forall a b. (IsString a, IsString b) => (a, b)
298+ringNumber = (C.dataRing, C.ringNumber)
299+
300+ringInt :: forall a b. (IsString a, IsString b) => (a, b)
301+ringInt = (C.dataRing, C.ringInt)
302+
303+euclideanRingNumber :: forall a b. (IsString a, IsString b) => (a, b)
304+euclideanRingNumber = (C.dataEuclideanRing, C.euclideanRingNumber)
305+
306+-- eqNumber :: forall a b. (IsString a, IsString b) => (a, b)
307+-- eqNumber = (C.dataEq, C.eqNumber)
308+
309+eqInt :: forall a b. (IsString a, IsString b) => (a, b)
310+eqInt = (C.dataEq, C.eqInt)
311+
312+eqString :: forall a b. (IsString a, IsString b) => (a, b)
313+eqString = (C.dataEq, C.eqString)
314+
315+eqChar :: forall a b. (IsString a, IsString b) => (a, b)
316+eqChar = (C.dataEq, C.eqChar)
317+
318+eqBoolean :: forall a b. (IsString a, IsString b) => (a, b)
319+eqBoolean = (C.dataEq, C.eqBoolean)
320+
321+ordBoolean :: forall a b. (IsString a, IsString b) => (a, b)
322+ordBoolean = (C.dataOrd, C.ordBoolean)
323+
324+ordNumber :: forall a b. (IsString a, IsString b) => (a, b)
325+ordNumber = (C.dataOrd, C.ordNumber)
326+
327+ordInt :: forall a b. (IsString a, IsString b) => (a, b)
328+ordInt = (C.dataOrd, C.ordInt)
329+
330+ordString :: forall a b. (IsString a, IsString b) => (a, b)
331+ordString = (C.dataOrd, C.ordString)
332+
333+ordChar :: forall a b. (IsString a, IsString b) => (a, b)
334+ordChar = (C.dataOrd, C.ordChar)
335+
336+semigroupString :: forall a b. (IsString a, IsString b) => (a, b)
337+semigroupString = (C.dataSemigroup, C.semigroupString)
338+
339+boundedBoolean :: forall a b. (IsString a, IsString b) => (a, b)
340+boundedBoolean = (C.dataBounded, C.boundedBoolean)
341+
342+heytingAlgebraBoolean :: forall a b. (IsString a, IsString b) => (a, b)
343+heytingAlgebraBoolean = (C.dataHeytingAlgebra, C.heytingAlgebraBoolean)
344+
345+semigroupoidFn :: forall a b. (IsString a, IsString b) => (a, b)
346+semigroupoidFn = (C.controlSemigroupoid, C.semigroupoidFn)
347+
348+opAdd :: forall a b. (IsString a, IsString b) => (a, b)
349+opAdd = (C.dataSemiring, C.add)
350+
351+opMul :: forall a b. (IsString a, IsString b) => (a, b)
352+opMul = (C.dataSemiring, C.mul)
353+
354+opEq :: forall a b. (IsString a, IsString b) => (a, b)
355+opEq = (C.dataEq, C.eq)
356+
357+opNotEq :: forall a b. (IsString a, IsString b) => (a, b)
358+opNotEq = (C.dataEq, C.notEq)
359+
360+opLessThan :: forall a b. (IsString a, IsString b) => (a, b)
361+opLessThan = (C.dataOrd, C.lessThan)
362+
363+opLessThanOrEq :: forall a b. (IsString a, IsString b) => (a, b)
364+opLessThanOrEq = (C.dataOrd, C.lessThanOrEq)
365+
366+opGreaterThan :: forall a b. (IsString a, IsString b) => (a, b)
367+opGreaterThan = (C.dataOrd, C.greaterThan)
368+
369+opGreaterThanOrEq :: forall a b. (IsString a, IsString b) => (a, b)
370+opGreaterThanOrEq = (C.dataOrd, C.greaterThanOrEq)
371+
372+opAppend :: forall a b. (IsString a, IsString b) => (a, b)
373+opAppend = (C.dataSemigroup, C.append)
374+
375+opSub :: forall a b. (IsString a, IsString b) => (a, b)
376+opSub = (C.dataRing, C.sub)
377+
378+opNegate :: forall a b. (IsString a, IsString b) => (a, b)
379+opNegate = (C.dataRing, C.negate)
380+
381+opDiv :: forall a b. (IsString a, IsString b) => (a, b)
382+opDiv = (C.dataEuclideanRing, C.div)
383+
384+opConj :: forall a b. (IsString a, IsString b) => (a, b)
385+opConj = (C.dataHeytingAlgebra, C.conj)
386+
387+opDisj :: forall a b. (IsString a, IsString b) => (a, b)
388+opDisj = (C.dataHeytingAlgebra, C.disj)
389+
390+opNot :: forall a b. (IsString a, IsString b) => (a, b)
391+opNot = (C.dataHeytingAlgebra, C.not)
392+
393+unbox :: AST -> PSString -> AST
394+unbox e d = select . inlineCommonValues $ inlineCommonOperators e
395+ where
396+ select :: AST -> AST
397+ select e' =
398+ case e' of
399+ Var{} -> unbox' e'
400+ App{} -> unbox' e'
401+ Indexer{} -> unbox' e'
402+ _ -> e'
403+ unbox' :: AST -> AST
404+ unbox' e' = maybe e' (\t -> App Nothing (StringLiteral Nothing t) [e']) $ unboxType d
405+
406+unboxType :: PSString -> Maybe PSString
407+unboxType s = do
408+ t <- decodeString s
409+ t' <- unboxType' t
410+ return $ mkString t'
411+ where
412+ unboxType' :: Text -> Maybe Text
413+ unboxType' t
414+ | t == C.eqInt ||
415+ t == C.semiringInt ||
416+ t == C.ringInt ||
417+ t == C.ordInt ||
418+ t == C.dataIntBits
419+ = Just int
420+ | t == C.semiringNumber ||
421+ t == C.ringNumber ||
422+ t == C.ordNumber ||
423+ t == C.euclideanRingNumber
424+ = Just float
425+ | t == C.eqBoolean ||
426+ t == C.ordBoolean ||
427+ t == C.heytingAlgebraBoolean
428+ = Just bool
429+ | t == C.eqChar ||
430+ t == C.eqString ||
431+ t == C.ordChar ||
432+ t == C.ordString ||
433+ t == C.semigroupString
434+ = Just string
435+ | otherwise = Nothing
src/CodeGen/IL/Optimizer/MagicDo.hsnew file+146
@@ -0,0 +1,146 @@
1+-- | This module implements the "Magic Do" optimization, which inlines calls to return
2+-- and bind for the Eff monad, as well as some of its actions.
3+module CodeGen.IL.Optimizer.MagicDo (magicDoEffect, magicDoEff, magicDoST, inlineST) where
4+
5+import Prelude.Compat
6+import Protolude (ordNub)
7+
8+import Data.Maybe (fromJust, isJust)
9+import Data.Text (Text)
10+
11+import Language.PureScript.CoreImp.AST
12+import Language.PureScript.CoreImp.Optimizer.Common hiding (isDict)
13+import Language.PureScript.PSString (PSString, decodeString, mkString)
14+import qualified Language.PureScript.Constants as C
15+
16+import CodeGen.IL.Common (undefinedName, unusedName)
17+import CodeGen.IL.Optimizer.Common
18+
19+-- | Inline type class dictionaries for >>= and return for the Eff monad
20+--
21+-- E.g.
22+--
23+-- Prelude[">>="](dict)(m1)(function(x) {
24+-- return ...;
25+-- })
26+--
27+-- becomes
28+--
29+-- function __do {
30+-- var x = m1();
31+-- ...
32+-- }
33+magicDoEff :: AST -> AST
34+magicDoEff = magicDo C.eff C.effDictionaries
35+
36+magicDoEffect :: AST -> AST
37+magicDoEffect = magicDo C.effect C.effectDictionaries
38+
39+magicDoST :: AST -> AST
40+magicDoST = magicDo C.st C.stDictionaries
41+
42+magicDo :: Text -> C.EffectDictionaries -> AST -> AST
43+magicDo effectModule C.EffectDictionaries{..} = everywhereTopDown convert
44+ where
45+ -- Desugar monomorphic calls to >>= and return for the Eff monad
46+ convert :: AST -> AST
47+ -- Desugar pure
48+ convert (App _ (App _ pure' [val]) []) | isPure pure' = val
49+ -- Desugar discard
50+ convert (App _ (App _ bind [m]) [Function s1 Nothing [unused] (Block s2 il)]) | isDiscard bind && unused == unusedName =
51+ Function s1 Nothing [] $ Block s2 (App s2 m [] : map applyReturns il )
52+ -- Desugar bind
53+ convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 il)]) | isBind bind =
54+ Function s1 Nothing [] $ Block s2 (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns il)
55+ -- Desugar untilE
56+ convert (App s1 (App _ f [arg]) []) | isEffFunc edUntil f =
57+ App s1 (Function s1 Nothing [] (Block s1 [ While s1 (Unary s1 Not (App s1 arg [])) (Block s1 []), Return s1 $ ObjectLiteral s1 []])) []
58+ -- Desugar whileE
59+ convert (App _ (App _ (App s1 f [arg1]) [arg2]) []) | isEffFunc edWhile f =
60+ App s1 (Function s1 Nothing [] (Block s1 [ While s1 (App s1 arg1 []) (Block s1 [ App s1 arg2 [] ]), Return s1 $ ObjectLiteral s1 []])) []
61+ -- -- Inline __do returns
62+ -- convert (Return _ (App _ (Function _ (Just ident) [] body) [])) | ident == fnName = body
63+ -- Inline double applications
64+ convert (App _ (App s1 (Function s2 Nothing [] (Block ss body)) []) []) =
65+ App s1 (Function s2 Nothing [] (Block ss (applyReturns `fmap` body))) []
66+ convert other = other
67+ -- Check if an expression represents a monomorphic call to >>= for the Eff monad
68+ isBind (App _ fn [dict]) | isDict (effectModule, edBindDict) dict && isBindPoly fn = True
69+ isBind _ = False
70+ -- Check if an expression represents a call to @discard@
71+ isDiscard (App _ (App _ fn [dict1]) [dict2])
72+ | isDict (C.controlBind, C.discardUnitDictionary) dict1 &&
73+ isDict (effectModule, edBindDict) dict2 &&
74+ isDiscardPoly fn = True
75+ isDiscard _ = False
76+
77+ -- Check if an expression represents a monomorphic call to pure or return for the Eff applicative
78+ isPure (App _ fn [dict]) | isDict (effectModule, edApplicativeDict) dict && isPurePoly fn = True
79+ isPure _ = False
80+ -- Check if an expression represents the polymorphic >>= function
81+ isBindPoly = isDict (C.controlBind, C.bind)
82+ -- Check if an expression represents the polymorphic pure function
83+ isPurePoly = isDict (C.controlApplicative, C.pure')
84+ -- Check if an expression represents the polymorphic discard function
85+ isDiscardPoly = isDict (C.controlBind, C.discard)
86+ -- Check if an expression represents a function in the Effect module
87+ isEffFunc name (Indexer _ (StringLiteral _ name') (Var _ eff)) = eff == effectModule && name == name'
88+ isEffFunc _ _ = False
89+
90+ applyReturns :: AST -> AST
91+ applyReturns (Return ss ret) = Return ss (App ss ret [])
92+ applyReturns (Block ss ils) = Block ss (map applyReturns ils)
93+ applyReturns (While ss cond il) = While ss cond (applyReturns il)
94+ applyReturns (For ss v lo hi il) = For ss v lo hi (applyReturns il)
95+ applyReturns (ForIn ss v xs il) = ForIn ss v xs (applyReturns il)
96+ applyReturns (IfElse ss cond t f) = IfElse ss cond (applyReturns t) (applyReturns `fmap` f)
97+ applyReturns other = other
98+
99+-- | Inline functions in the ST module
100+inlineST :: AST -> AST
101+inlineST = everywhere convertBlock
102+ where
103+ -- Look for runST blocks and inline the STRefs there.
104+ -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
105+ -- we can be more aggressive about inlining, and actually turn STRefs into local variables.
106+ convertBlock (App s1 f [arg]) | isSTFunc C.runST f =
107+ let refs = ordNub . findSTRefsIn $ arg
108+ usages = findAllSTUsagesIn arg
109+ allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
110+ localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs
111+ in App s1 (everywhere (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg) []
112+ convertBlock other = other
113+ -- Convert a block in a safe way, preserving object wrappers of references,
114+ -- or in a more aggressive way, turning wrappers into local variables depending on the
115+ -- agg(ressive) parameter.
116+ convert agg (App s1 f [arg]) | isSTFunc C.newSTRef f =
117+ Function s1 Nothing [] (Block s1 [Return s1 $ if agg then arg else ObjectLiteral s1 [(mkString C.stRefValue, arg)]])
118+ convert agg (App _ (App s1 f [ref]) []) | isSTFunc C.readSTRef f =
119+ if agg then ref else Indexer s1 (StringLiteral s1 C.stRefValue) ref
120+ convert agg (App _ (App _ (App s1 f [arg]) [ref]) []) | isSTFunc C.writeSTRef f =
121+ if agg then Assignment s1 ref arg else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) arg
122+ convert agg (App _ (App _ (App s1 f [func]) [ref]) []) | isSTFunc C.modifySTRef f =
123+ if agg then Assignment s1 ref (App s1 func [ref]) else Assignment s1 (Indexer s1 (StringLiteral s1 C.stRefValue) ref) (App s1 func [Indexer s1 (StringLiteral s1 C.stRefValue) ref])
124+ convert _ other = other
125+ -- Check if an expression represents a function in the ST module
126+ isSTFunc name (Indexer _ (StringLiteral _ name') (Var _ st)) = st == C.st && name == name'
127+ isSTFunc _ _ = False
128+ -- Find all ST Refs initialized in this block
129+ findSTRefsIn = everything (++) isSTRef
130+ where
131+ isSTRef (VariableIntroduction _ ident (Just (App _ (App _ f [_]) []))) | isSTFunc C.newSTRef f = [ident]
132+ isSTRef _ = []
133+ -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef
134+ findAllSTUsagesIn = everything (++) isSTUsage
135+ where
136+ isSTUsage (App _ (App _ f [ref]) []) | isSTFunc C.readSTRef f = [ref]
137+ isSTUsage (App _ (App _ (App _ f [_]) [ref]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]
138+ isSTUsage _ = []
139+ -- Find all uses of a variable
140+ appearingIn ref = everything (++) isVar
141+ where
142+ isVar e@(Var _ v) | v == ref = [e]
143+ isVar _ = []
144+ -- Convert a AST value to a String if it is a Var
145+ toVar (Var _ v) = Just v
146+ toVar _ = Nothing
src/CodeGen/IL/Optimizer/TCO.hsnew file+141
@@ -0,0 +1,141 @@
1+module CodeGen.IL.Optimizer.TCO (tco, tcoLoop) where
2+
3+import Prelude.Compat
4+
5+import Data.Text (Text)
6+import Data.Monoid ((<>))
7+import Language.PureScript.CoreImp.AST
8+import Language.PureScript.AST.SourcePos (SourceSpan)
9+import Safe (headDef, tailSafe)
10+import CodeGen.IL.Common
11+
12+import qualified Language.PureScript.Constants as C
13+
14+tcoLoop :: Text
15+tcoLoop = "ṩtco_loop"
16+
17+tco :: AST -> AST -> AST
18+tco mn = everywhere convert where
19+ tcoVar :: Text -> Text
20+ tcoVar arg = "ṩtco_var_" <> arg
21+
22+ copyVar :: Text -> Text
23+ copyVar arg = "ṩcopy_" <> arg
24+
25+ tcoDone :: Text
26+ tcoDone = "ṩtco_done"
27+
28+ tcoResult :: Text
29+ tcoResult = "ṩtco_result"
30+
31+ convert :: AST -> AST
32+ convert fn@(Function ss (Just name) args _)
33+ | isTailRecursive name body'
34+ = replace (toLoop name outerArgs innerArgs body')
35+ where
36+ innerArgs = headDef [] argss
37+ outerArgs = concat . reverse $ tailSafe argss
38+ (argss, body', replace) = collectAllFunctionArgs [] id fn
39+ convert (Assignment ss (Var _ name) fn@(Function _ Nothing _ _))
40+ | isTailRecursive name body'
41+ = Assignment ss (Var ss name) (replace (toLoop name outerArgs innerArgs body'))
42+ where
43+ innerArgs = headDef [] argss
44+ outerArgs = concat . reverse $ tailSafe argss
45+ (argss, body', replace) = collectAllFunctionArgs [] id fn
46+ convert js = js
47+
48+ collectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
49+ collectAllFunctionArgs allArgs f (Function s1 ident args (Block s2 (body@(Return _ _):_))) =
50+ collectAllFunctionArgs (args : allArgs) (\b -> f (Function s1 ident (map copyVar args) (Block s2 [b]))) body
51+ collectAllFunctionArgs allArgs f (Function ss ident args body@(Block _ _)) =
52+ (args : allArgs, body, f . Function ss ident (map copyVar args))
53+ collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args (Block s3 [body]))) =
54+ collectAllFunctionArgs (args : allArgs) (\b -> f (Return s1 (Function s2 ident (map copyVar args) (Block s3 [b])))) body
55+ collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args body@(Block _ _))) =
56+ (args : allArgs, body, f . Return s1 . Function s2 ident (map copyVar args))
57+ collectAllFunctionArgs allArgs f body = (allArgs, body, f)
58+
59+ isTailRecursive :: Text -> AST -> Bool
60+ isTailRecursive ident js = countSelfReferences js > 0 && allInTailPosition js where
61+ countSelfReferences = everything (+) match where
62+ match :: AST -> Int
63+ match (Var _ ident') | ident == ident' = 1
64+ match _ = 0
65+
66+ allInTailPosition (Return _ expr)
67+ | isSelfCall ident expr = countSelfReferences expr == 1
68+ | otherwise = countSelfReferences expr == 0
69+ allInTailPosition (While _ js1 body)
70+ = countSelfReferences js1 == 0 && allInTailPosition body
71+ allInTailPosition (For _ _ js1 js2 body)
72+ = countSelfReferences js1 == 0 && countSelfReferences js2 == 0 && allInTailPosition body
73+ allInTailPosition (ForIn _ _ js1 body)
74+ = countSelfReferences js1 == 0 && allInTailPosition body
75+ allInTailPosition (IfElse _ js1 body el)
76+ = countSelfReferences js1 == 0 && allInTailPosition body && all allInTailPosition el
77+ allInTailPosition (Block _ body)
78+ = all allInTailPosition body
79+ allInTailPosition (Throw _ js1)
80+ = countSelfReferences js1 == 0
81+ allInTailPosition (ReturnNoResult _)
82+ = True
83+ allInTailPosition (VariableIntroduction _ _ js1)
84+ = all ((== 0) . countSelfReferences) js1
85+ allInTailPosition (Assignment _ _ js1)
86+ = countSelfReferences js1 == 0
87+ allInTailPosition (Comment _ _ js1)
88+ = allInTailPosition js1
89+ allInTailPosition _
90+ = False
91+
92+ toLoop :: Text -> [Text] -> [Text] -> AST -> AST
93+ toLoop ident outerArgs innerArgs js =
94+ Block rootSS $
95+ concatMap (\arg -> [ VariableIntroduction rootSS (tcoVar arg) . Just $
96+ Var rootSS (copyVar arg) ]) (outerArgs ++ innerArgs) ++
97+ [ Assignment rootSS (Var rootSS $ "var " <> tcoDone) $ BooleanLiteral Nothing False
98+ , VariableIntroduction rootSS tcoResult Nothing
99+ , Assignment rootSS (Var rootSS $ "var " <> tcoLoop) (Function rootSS (Just tcoLoop) (outerArgs ++ innerArgs) (Block rootSS [loopify js]))
100+ , While rootSS (Unary Nothing Not (Var rootSS tcoDone))
101+ (Block rootSS
102+ [(Assignment rootSS (Var rootSS tcoResult) (App rootSS (Var rootSS tcoLoop) ((map (Var rootSS . tcoVar) outerArgs) ++ (map (Var rootSS . copyVar) innerArgs))))])
103+ , Return rootSS (Var rootSS tcoResult)
104+ ]
105+ where
106+ rootSS = Nothing
107+
108+ loopify :: AST -> AST
109+ loopify (Return ss ret)
110+ | isSelfCall ident ret =
111+ let
112+ allArgumentValues = concat $ collectArgs [] ret
113+ in
114+ Block ss $
115+ zipWith (\val arg ->
116+ Assignment ss (Var ss (tcoVar arg)) val) allArgumentValues outerArgs
117+ ++ zipWith (\val arg ->
118+ Assignment ss (Var ss (copyVar arg)) val) (drop (length outerArgs) allArgumentValues) innerArgs
119+ ++ [ ReturnNoResult ss ]
120+ | otherwise = Block ss [ markDone ss, Return ss ret ]
121+ loopify (ReturnNoResult ss) = Block ss [ markDone ss, ReturnNoResult ss ]
122+ loopify (While ss cond body) = While ss cond (loopify body)
123+ loopify (For ss i js1 js2 body) = For ss i js1 js2 (loopify body)
124+ loopify (ForIn ss i js1 body) = ForIn ss i js1 (loopify body)
125+ loopify (IfElse ss cond body el) = IfElse ss cond (loopify body) (fmap loopify el)
126+ loopify (Block ss body) = Block ss (map loopify body)
127+ loopify other = other
128+
129+ markDone :: Maybe SourceSpan -> AST
130+ markDone ss = Assignment ss (Var ss tcoDone) (BooleanLiteral ss True)
131+
132+ collectArgs :: [[AST]] -> AST -> [[AST]]
133+ collectArgs acc (App _ fn args') = collectArgs (args' : acc) fn
134+ collectArgs acc _ = acc
135+
136+ isSelfCall :: Text -> AST -> Bool
137+ isSelfCall ident (App _ (Var _ ident') _) = ident == ident'
138+ isSelfCall ident (App _ (Indexer _ (Var _ ident') (Var _ mn')) _) = mn' == "" && ident == ident'
139+ isSelfCall ident (App _ (Indexer _ (Var _ ident') mn') _) = mn' == mn && ident == ident'
140+ isSelfCall ident (App _ fn _) = isSelfCall ident fn
141+ isSelfCall _ _ = False
src/CodeGen/IL/Printer.hsnew file+527
@@ -0,0 +1,527 @@
1+-- | Pretty printer for the AST
2+module CodeGen.IL.Printer
3+ ( prettyPrintIL
4+ , prettyPrintIL1
5+ , prettyPrintILWithSourceMaps
6+ , interfaceSource
7+ , implHeaderSource
8+ , implFooterSource
9+ , isLiteral
10+ , modLabel
11+ , modPrefix
12+ , ffiLoader
13+ ) where
14+
15+import Prelude.Compat
16+
17+import Control.Arrow ((<+>))
18+import Control.Monad (forM, mzero)
19+import Control.Monad.State (StateT, evalStateT)
20+import Control.PatternArrows
21+import Data.List (filter, (\\))
22+import qualified Control.Arrow as A
23+
24+import Data.Maybe (fromMaybe)
25+import Data.Monoid ((<>))
26+import Data.Text (Text)
27+import qualified Data.Text as T
28+
29+import Language.PureScript.AST (SourceSpan(..))
30+import Language.PureScript.CoreImp.AST
31+import Language.PureScript.Comments
32+import Language.PureScript.Crash
33+import Language.PureScript.Names (Ident, runIdent)
34+import Language.PureScript.Pretty.Common
35+import Language.PureScript.PSString (PSString, decodeString, mkString)
36+
37+import CodeGen.IL.Common
38+import CodeGen.IL.Optimizer.TCO (tcoLoop)
39+
40+import qualified Language.PureScript.Constants as C
41+
42+-- TODO (Christoph): Get rid of T.unpack / pack
43+
44+literals :: (Emit gen) => Pattern PrinterState AST gen
45+literals = mkPattern' match'
46+ where
47+ match' :: (Emit gen) => AST -> StateT PrinterState Maybe gen
48+ match' il = (addMapping' (getSourceSpan il) <>) <$> match il
49+
50+ match :: (Emit gen) => AST -> StateT PrinterState Maybe gen
51+ match (NumericLiteral _ n) = return $ emit $ T.pack $ either show show n
52+ match (StringLiteral _ s) = return $ emit $ stringLiteral s
53+ match (BooleanLiteral _ True) = return $ emit "true"
54+ match (BooleanLiteral _ False) = return $ emit "false"
55+ match (ArrayLiteral _ xs) = mconcat <$> sequence
56+ [ return . emit $ arrayType <> "{"
57+ , intercalate (emit ", ") <$> forM xs prettyPrintIL'
58+ , return $ emit "}"
59+ ]
60+ -- match (ObjectLiteral _ []) = return $ emit "std::initializer_list<std::pair<const string, boxed>>{}"
61+ match (ObjectLiteral _ ps) = mconcat <$> sequence
62+ [ return . emit $ dictType <> "{"
63+ , withIndent $ do
64+ ils <- forM ps $ \(key, value) -> do
65+ value' <- prettyPrintIL' value
66+ return $ objectPropertyToString key <> value'
67+ return $ intercalate (emit " ") $ map (<> emit ",") ils
68+ , return $ emit "}"
69+ ]
70+ where
71+ objectPropertyToString :: (Emit gen) => PSString -> gen
72+ objectPropertyToString s = emit $ stringLiteral s <> ": "
73+ match (Block _ sts) = mconcat <$> sequence
74+ [ return $ emit "{\n"
75+ , withIndent $ prettyStatements sts
76+ , return $ emit "\n"
77+ , currentIndent
78+ , return $ emit "}"
79+ ]
80+ match (Var _ ident) | ident == C.undefined = return $ emit undefinedName
81+ match (Var _ ident) = return $ emit ident
82+ match (VariableIntroduction _ ident value) = mconcat <$> sequence
83+ [ return . emit $ varDecl <> " " <> ident <> " " <> anyType
84+ , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintIL') value
85+ ]
86+ match (Assignment _ target value) = mconcat <$> sequence
87+ [ prettyPrintIL' target
88+ , return $ emit " = "
89+ , prettyPrintIL' value
90+ ]
91+ match (App _ val []) = mconcat <$> sequence
92+ [ return $ emit "Run("
93+ , prettyPrintIL' val
94+ , return $ emit ")"
95+ ]
96+ match (App _ (StringLiteral _ u) [arg])
97+ | Just ty <- decodeString u = mconcat <$> sequence
98+ [ prettyPrintIL' arg
99+ , return $ emit ".("
100+ , return $ emit ty
101+ , return $ emit ")"
102+ ]
103+ match (App _ (Var _ fn) [arg]) | fn == arrayLengthFn = mconcat <$> sequence
104+ [ return $ emit fn
105+ , return $ emit "("
106+ , prettyPrintIL' arg
107+ , return $ emit ")"
108+ ]
109+ match (App _ (Var _ fn) args) | fn == indexFn = mconcat <$> sequence
110+ [ return $ emit fn
111+ , return $ emit "("
112+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
113+ , return $ emit ")"
114+ ]
115+ match (App _ (Var _ fn) args) | fn == tcoLoop = mconcat <$> sequence
116+ [ return $ emit fn
117+ , return $ emit "("
118+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
119+ , return $ emit ")"
120+ ]
121+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn@Function{}]) args)
122+ | Just ftype <- decodeString fnx
123+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
124+ [ prettyPrintIL' fn
125+ , return $ emit "("
126+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
127+ , return $ emit ")"
128+ ]
129+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn]) args)
130+ | Just ftype <- decodeString fnx
131+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
132+ [ prettyPrintIL' fn
133+ , return $ emit ".("
134+ , return $ emit ftype
135+ , return $ emit ")("
136+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
137+ , return $ emit ")"
138+ ]
139+ match app@(App{})
140+ | (val, args) <- unApp app []
141+ , length args > 1
142+ = mconcat <$> sequence
143+ [ return $ emit "Apply("
144+ , prettyPrintIL' val
145+ , return $ emit ", "
146+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
147+ , return $ emit ")"
148+ ]
149+ match (App _ val args) = mconcat <$> sequence
150+ [ return $ emit "Apply("
151+ , prettyPrintIL' val
152+ , return $ emit ", "
153+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
154+ , return $ emit ")"
155+ ]
156+ match (Function _ (Just name) [] (Block _ [Return _ ret]))
157+ | isComplexLiteral ret = mconcat <$> sequence
158+ [ return $ emit "\n"
159+ , return . emit $ varDecl <> " " <> initName name <> " Once\n"
160+ , prettyPrintIL' $ VariableIntroduction Nothing (valueName name) Nothing
161+ , return $ emit "\n\n"
162+ , return $ emit "func "
163+ , return . emit $ withPrefix name
164+ , return . emit $ "() " <> anyType <> " "
165+ , return $ emit "{\n"
166+ , withIndent $ do
167+ indentString <- currentIndent
168+ return $ indentString <> (emit $ initName name <> ".Do(func() {\n") <>
169+ indentString <> indentString <> (emit $ valueName name <> " = ")
170+ , withIndent $ do
171+ case ret of
172+ Function _ Nothing args body -> mconcat <$> sequence
173+ [ return $ emit "func("
174+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
175+ , return . emit $ ") " <> anyType <> " "
176+ , prettyPrintIL' body
177+ ]
178+ _ -> do
179+ prettyPrintIL' ret
180+ , return $ emit "\n"
181+ , withIndent $ do
182+ indentString <- currentIndent
183+ return $ indentString <> (emit $ "})\n" <> "return " <> valueName name <>"\n")
184+ , return $ emit "}\n\n"
185+ ]
186+ match (Function _ (Just name) [] ret) = mconcat <$> sequence
187+ [ return $ emit "func "
188+ , return . emit $ withPrefix name
189+ , return . emit $ "() " <> anyType <> " "
190+ , prettyPrintIL' ret
191+ ]
192+ match (Function _ _ args ret) = mconcat <$> sequence
193+ [ return $ emit "func("
194+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
195+ , return . emit $ ") " <> anyType <> " "
196+ , prettyPrintIL' ret
197+ ]
198+ match (Indexer _ (Var _ name) (Var _ "")) = mconcat <$> sequence
199+ [ prettyPrintIL' (Var Nothing $ withPrefix name)
200+ , return $ emit "()"
201+ ]
202+ match (Indexer _ (Var _ name) val) = mconcat <$> sequence
203+ [ prettyPrintIL' val
204+ , return $ emit "."
205+ , prettyPrintIL' (Var Nothing $ withPrefix name)
206+ , return $ emit "()"
207+ ]
208+ match (Indexer _ prop@StringLiteral{} val@ObjectLiteral{}) = mconcat <$> sequence
209+ [ prettyPrintIL' val
210+ , return $ emit "["
211+ , prettyPrintIL' prop
212+ , return $ emit "]"
213+ ]
214+ match (Indexer _ prop@StringLiteral{} val) = mconcat <$> sequence
215+ [ prettyPrintIL' val
216+ , return $ emit ".("
217+ , return $ emit dictType
218+ , return $ emit ")["
219+ , prettyPrintIL' prop
220+ , return $ emit "]"
221+ ]
222+ match (Indexer _ index val@ArrayLiteral{}) = mconcat <$> sequence
223+ [ prettyPrintIL' val
224+ , return $ emit "["
225+ , prettyPrintIL' index
226+ , return $ emit "]"
227+ ]
228+ match (Indexer _ index val) = mconcat <$> sequence
229+ [ prettyPrintIL' val
230+ , return $ emit ".("
231+ , return $ emit arrayType
232+ , return $ emit ")["
233+ , prettyPrintIL' index
234+ , return $ emit "]"
235+ ]
236+ match (InstanceOf _ val ty) = mconcat <$> sequence
237+ [ return $ emit "Is("
238+ , prettyPrintIL' val
239+ , return $ emit ", "
240+ , prettyPrintIL' ty
241+ , return $ emit ")"
242+ ]
243+ match (While _ cond sts) = mconcat <$> sequence
244+ [ return $ emit "for "
245+ , prettyPrintIL' cond
246+ , return $ emit " "
247+ , prettyPrintIL' sts
248+ ]
249+ match (For _ ident start end sts) = mconcat <$> sequence
250+ [ return $ emit $ "for var " <> ident <> " = "
251+ , prettyPrintIL' start
252+ , return $ emit $ "; " <> ident <> " < "
253+ , prettyPrintIL' end
254+ , return $ emit $ "; " <> ident <> "++ "
255+ , prettyPrintIL' sts
256+ ]
257+ match (ForIn _ ident obj sts) = mconcat <$> sequence
258+ [ return $ emit $ "for var " <> ident <> " in "
259+ , prettyPrintIL' obj
260+ , return $ emit " "
261+ , prettyPrintIL' sts
262+ ]
263+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (BooleanLiteral Nothing True)) thens elses) = mconcat <$> sequence
264+ [ return $ emit "if "
265+ , prettyPrintIL' cond
266+ , return $ emit " "
267+ , prettyPrintIL' thens
268+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
269+ ]
270+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (BooleanLiteral Nothing False)) thens elses) = mconcat <$> sequence
271+ [ return $ emit "if !("
272+ , prettyPrintIL' cond
273+ , return $ emit ") "
274+ , prettyPrintIL' thens
275+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
276+ ]
277+ match (IfElse _ cond thens elses) = mconcat <$> sequence
278+ [ return $ emit "if "
279+ , prettyPrintIL' cond
280+ , return $ emit " "
281+ , prettyPrintIL' thens
282+ , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
283+ ]
284+ match (Return _ value) = mconcat <$> sequence
285+ [ return $ emit "return "
286+ , prettyPrintIL' value
287+ ]
288+ match (ReturnNoResult _) = return . emit $ "return " <> undefinedName
289+ -- match (Throw _ _) = return mempty
290+ match (Throw _ value) = mconcat <$> sequence
291+ [ return $ emit "panic("
292+ , prettyPrintIL' value
293+ , return $ emit ")"
294+ ]
295+ match (Comment _ com il) = mconcat <$> sequence
296+ [ return $ emit "\n"
297+ , mconcat <$> forM com comment
298+ , prettyPrintIL' il
299+ ]
300+ match _ = mzero
301+
302+ comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen
303+ comment (LineComment com) = fmap mconcat $ sequence $
304+ [ currentIndent
305+ , return $ emit "//" <> emit com <> emit "\n"
306+ ]
307+ comment (BlockComment com) = fmap mconcat $ sequence $
308+ [ currentIndent
309+ , return $ emit "/**\n"
310+ ] ++
311+ map asLine (T.lines com) ++
312+ [ currentIndent
313+ , return $ emit " */\n"
314+ , currentIndent
315+ ]
316+ where
317+ asLine :: (Emit gen) => Text -> StateT PrinterState Maybe gen
318+ asLine s = do
319+ i <- currentIndent
320+ return $ i <> emit " * " <> (emit . removeComments) s <> emit "\n"
321+
322+ removeComments :: Text -> Text
323+ removeComments t =
324+ case T.stripPrefix "*/" t of
325+ Just rest -> removeComments rest
326+ Nothing -> case T.uncons t of
327+ Just (x, xs) -> x `T.cons` removeComments xs
328+ Nothing -> ""
329+
330+unary' :: (Emit gen) => UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
331+unary' op mkStr = Wrap match (<>)
332+ where
333+ match :: (Emit gen) => Pattern PrinterState AST (gen, AST)
334+ match = mkPattern match'
335+ where
336+ match' (Unary _ op' val) | op' == op = Just (emit $ mkStr val, val)
337+ match' _ = Nothing
338+
339+unary :: (Emit gen) => UnaryOperator -> Text -> Operator PrinterState AST gen
340+unary op str = unary' op (const str)
341+
342+negateOperator :: (Emit gen) => Operator PrinterState AST gen
343+negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")
344+ where
345+ isNegate (Unary _ Negate _) = True
346+ isNegate _ = False
347+
348+binary :: (Emit gen) => BinaryOperator -> Text -> Operator PrinterState AST gen
349+binary op str = AssocL match (\v1 v2 -> v1 <> emit (" " <> str <> " ") <> v2)
350+ where
351+ match :: Pattern PrinterState AST (AST, AST)
352+ match = mkPattern match'
353+ where
354+ match' (Binary _ op' v1 v2) | op' == op = Just (v1, v2)
355+ match' _ = Nothing
356+
357+isLiteral :: AST -> Bool
358+isLiteral Function{} = True
359+isLiteral NumericLiteral{} = True
360+isLiteral StringLiteral{} = True
361+isLiteral BooleanLiteral{} = True
362+isLiteral ObjectLiteral{} = True
363+isLiteral ArrayLiteral{} = True
364+isLiteral _ = False
365+
366+isComplexLiteral :: AST -> Bool
367+-- isComplexLiteral Function{} = True
368+isComplexLiteral ObjectLiteral{} = True
369+isComplexLiteral ArrayLiteral{} = True
370+isComplexLiteral _ = False
371+
372+unApp :: AST -> [AST] -> (AST, [AST])
373+unApp (App _ val [arg]) args = unApp val (arg : args)
374+unApp other args = (other, args)
375+
376+prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen
377+prettyStatements sts = do
378+ ils <- forM sts prettyPrintIL'
379+ indentString <- currentIndent
380+ return $ intercalate (emit "\n") $ map (indentString <>) ils
381+
382+-- | Generate a pretty-printed string representing a collection of C++ expressions at the same indentation level
383+prettyPrintILWithSourceMaps :: [AST] -> (Text, [SMap])
384+prettyPrintILWithSourceMaps il =
385+ let StrPos (_, s, mp) = (fromMaybe (internalError "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyStatements) il
386+ in (s, mp)
387+
388+prettyPrintIL :: [AST] -> Text
389+prettyPrintIL = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyStatements
390+
391+-- | Generate an indented, pretty-printed string representing a C++ expression
392+prettyPrintIL' :: (Emit gen) => AST -> StateT PrinterState Maybe gen
393+prettyPrintIL' = A.runKleisli $ runPattern matchValue
394+ where
395+ matchValue :: (Emit gen) => Pattern PrinterState AST gen
396+ matchValue = buildPrettyPrinter operators (literals <+> fmap parensPos matchValue)
397+ operators :: (Emit gen) => OperatorTable PrinterState AST gen
398+ operators =
399+ OperatorTable [ [ unary New "?" ]
400+ , [ unary Not "!"
401+ , unary BitwiseNot "~"
402+ , unary Positive "+"
403+ , negateOperator ]
404+ , [ binary Multiply "*"
405+ , binary Divide "/"
406+ , binary Modulus "%" ]
407+ , [ binary Add "+"
408+ , binary Subtract "-" ]
409+ , [ binary ShiftLeft "<<"
410+ , binary ShiftRight ">>" ]
411+ , [ binary LessThan "<"
412+ , binary LessThanOrEqualTo "<="
413+ , binary GreaterThan ">"
414+ , binary GreaterThanOrEqualTo ">=" ]
415+ , [ binary EqualTo "=="
416+ , binary NotEqualTo "!=" ]
417+ , [ binary BitwiseAnd "&" ]
418+ , [ binary BitwiseXor "^" ]
419+ , [ binary BitwiseOr "|" ]
420+ , [ binary And "&&" ]
421+ , [ binary Or "||" ]
422+ ]
423+
424+prettyPrintIL1 :: AST -> Text
425+prettyPrintIL1 = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyPrintIL'
426+
427+stringLiteral :: PSString -> Text
428+stringLiteral pss | Just s <- decodeString pss = stringLiteral' s
429+ where
430+ stringLiteral' :: Text -> Text
431+ stringLiteral' s = "\"" <> T.concatMap encodeChar s <> "\""
432+ encodeChar :: Char -> Text
433+ encodeChar '\0' = "\\x00"
434+ encodeChar '\b' = "\\b"
435+ encodeChar '\t' = "\\t"
436+ encodeChar '\n' = "\\n"
437+ encodeChar '\v' = "\\v"
438+ encodeChar '\f' = "\\f"
439+ encodeChar '\r' = "\\r"
440+ encodeChar '"' = "\\\""
441+ encodeChar '\\' = "\\\\"
442+ encodeChar c = T.singleton $ c
443+stringLiteral _ = "\"\\uFFFD\""
444+
445+interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
446+interfaceSource _ _ _ = ""
447+
448+implHeaderSource :: Text -> [Text] -> Text -> Text
449+implHeaderSource mn imports otherPrefix =
450+ "// Code generated by psgo. DO NOT EDIT.\n\n" <>
451+ "package " <> (if mn == "Main" || mn == "Test_Main" then "main" else mn) <> "\n\n" <>
452+ "import . \"" <> runtime <> "\"\n" <>
453+ (if mn == "Main" || mn == "Test_Main"
454+ then "import _ \"" <> otherPrefix <> "/" <> ffiLoader <> "\"\n"
455+ else "\n") <>
456+ "import (\n" <>
457+ (T.concat $ formatImport <$> imports) <> ")\n\n" <>
458+ "type _ = Any\n\n"
459+ where
460+ formatImport :: Text -> Text
461+ formatImport s =
462+ "\t\"" <> otherPrefix <> "/" <> modPrefix <> "/" <> moduleRenamer s <> "\"\n"
463+ moduleRenamer :: Text -> Text
464+ moduleRenamer s
465+ | (s', sfx) <- T.breakOn moduleRenamerMarker s,
466+ not $ T.null sfx = s'
467+ moduleRenamer s = s
468+
469+implFooterSource :: Text -> [Ident] -> Text
470+implFooterSource mn foreigns =
471+ "\n\n\n" <>
472+ (if null foreigns
473+ then ""
474+ else ("// Foreign values\n\n" <>
475+ "var " <> foreignDict <> " = "<> foreignMod <> "(\"" <> mn <> "\")\n\n" <>
476+ (T.concat $ (\foreign' ->
477+ let name = moduleIdentToIL foreign' in
478+ varDecl <> " " <> initName name <> " Once\n" <>
479+ varDecl <> " " <> valueName name <> " " <> anyType <> "\n\n" <>
480+ "func " <>
481+ withPrefix name <>
482+ "() Any { \n" <>
483+ " " <> initName name <> ".Do(func() {\n" <>
484+ " " <> valueName name <> " = " <>
485+ "Get(" <> foreignDict <> ", " <>
486+ (stringLiteral . mkString $ runIdent foreign') <> ")\n" <>
487+ " })\n" <>
488+ " return " <> valueName name <> "\n" <>
489+ "}\n\n") <$> foreigns))) <>
490+ if mn == "Main" || mn == "Test.Main" then mainSource else "\n"
491+ where
492+ mainSource :: Text
493+ mainSource = "\
494+ \func main() {\n\
495+ \ Run(Ꞌmain())\n\
496+ \}\n\n\
497+ \"
498+
499+varDecl :: Text
500+varDecl = "var"
501+
502+renderArg :: Text -> Text -> Text
503+renderArg decl arg = arg <> " " <> decl
504+
505+foreignMod :: Text
506+foreignMod = "Foreign"
507+
508+foreignDict :: Text
509+foreignDict = "foreign"
510+
511+modLabel :: Text
512+modLabel = "purescript-native"
513+
514+modPrefix :: Text
515+modPrefix = modLabel <> "/output"
516+
517+runtime :: Text
518+runtime = "github.com/" <> modLabel <> "/go-runtime"
519+
520+ffiLoader :: Text
521+ffiLoader = modLabel <> "/ffi-loader"
522+
523+initName :: Text -> Text
524+initName s = "ᛌ" <> s <> "_once"
525+
526+valueName :: Text -> Text
527+valueName s = "ᛧ" <> s
src/Control/Monad/Supply.hsdeleted−46
@@ -1,46 +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−{-# LANGUAGE CPP #-}
18−
19−module Control.Monad.Supply where
20−
21−import Data.Functor.Identity
22−
23−#if __GLASGOW_HASKELL__ < 710
24−import Control.Applicative
25−#endif
26−import Control.Monad.State
27−import Control.Monad.Error.Class (MonadError(..))
28−import Control.Monad.Reader
29−import Control.Monad.Writer
30−
31−newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }
32− deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r)
33−
34−runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)
35−runSupplyT n = flip runStateT n . unSupplyT
36−
37−evalSupplyT :: (Functor m) => Integer -> SupplyT m a -> m a
38−evalSupplyT n = fmap fst . runSupplyT n
39−
40−type Supply = SupplyT Identity
41−
42−runSupply :: Integer -> Supply a -> (a, Integer)
43−runSupply n = runIdentity . runSupplyT n
44−
45−evalSupply :: Integer -> Supply a -> a
46−evalSupply n = runIdentity . evalSupplyT n
src/Control/Monad/Supply/Class.hsdeleted−36
@@ -1,36 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Control.Monad.Supply.Class
4−-- Copyright : (c) PureScript 2015
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- A class for monads supporting a supply of fresh names
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE MultiParamTypeClasses #-}
17−
18−module Control.Monad.Supply.Class where
19−
20−import Control.Monad.Supply
21−import Control.Monad.State
22−
23−class (Monad m) => MonadSupply m where
24− fresh :: m Integer
25−
26−instance (Monad m) => MonadSupply (SupplyT m) where
27− fresh = SupplyT $ do
28− n <- get
29− put (n + 1)
30− return n
31−
32−instance (MonadSupply m) => MonadSupply (StateT s m) where
33− fresh = lift fresh
34−
35−freshName :: (MonadSupply m) => m String
36−freshName = liftM (('_' :) . show) fresh
src/Control/Monad/Unify.hsdeleted−160
@@ -1,160 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Control.Monad.Unify
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17−{-# LANGUAGE FlexibleInstances #-}
18−{-# LANGUAGE FlexibleContexts #-}
19−{-# LANGUAGE DeriveDataTypeable #-}
20−{-# LANGUAGE MultiParamTypeClasses #-}
21−{-# LANGUAGE FunctionalDependencies #-}
22−{-# LANGUAGE UndecidableInstances #-}
23−
24−module Control.Monad.Unify where
25−
26−import Data.Monoid
27−
28−import Control.Applicative
29−import Control.Monad.State
30−import Control.Monad.Error.Class (MonadError(..))
31−import Control.Monad.Writer.Class (MonadWriter(..))
32−
33−import Data.HashMap.Strict as M
34−
35−-- |
36−-- Untyped unification variables
37−--
38−type Unknown = Int
39−
40−-- |
41−-- A type which can contain unification variables
42−--
43−class Partial t where
44− unknown :: Unknown -> t
45− isUnknown :: t -> Maybe Unknown
46− unknowns :: t -> [Unknown]
47− ($?) :: Substitution t -> t -> t
48−
49−-- |
50−-- Identifies types which support unification
51−--
52−class (Partial t) => Unifiable m t | t -> m where
53− (=?=) :: t -> t -> UnifyT t m ()
54−
55−-- |
56−-- A substitution maintains a mapping from unification variables to their values
57−--
58−data Substitution t = Substitution { runSubstitution :: M.HashMap Int t }
59−
60−instance (Partial t) => Monoid (Substitution t) where
61− mempty = Substitution M.empty
62− s1 `mappend` s2 = Substitution $
63− M.map (s2 $?) (runSubstitution s1) `M.union`
64− M.map (s1 $?) (runSubstitution s2)
65−
66−-- |
67−-- State required for type checking
68−--
69−data UnifyState t = UnifyState {
70− -- |
71− -- The next fresh unification variable
72− --
73− unifyNextVar :: Int
74− -- |
75− -- The current substitution
76− --
77− , unifyCurrentSubstitution :: Substitution t
78− }
79−
80−-- |
81−-- An empty @UnifyState@
82−--
83−defaultUnifyState :: (Partial t) => UnifyState t
84−defaultUnifyState = UnifyState 0 mempty
85−
86−-- |
87−-- A class for errors which support unification errors
88−--
89−class UnificationError t e where
90− occursCheckFailed :: t -> e
91−
92−-- |
93−-- The type checking monad, which provides the state of the type checker, and error reporting capabilities
94−--
95−newtype UnifyT t m a = UnifyT { unUnify :: StateT (UnifyState t) m a }
96− deriving (Functor, Monad, Applicative, Alternative, MonadPlus, MonadWriter w)
97−
98−instance (MonadState s m) => MonadState s (UnifyT t m) where
99− get = UnifyT . lift $ get
100− put = UnifyT . lift . put
101−
102−instance (MonadError e m) => MonadError e (UnifyT t m) where
103− throwError = UnifyT . throwError
104− catchError e f = UnifyT $ catchError (unUnify e) (unUnify . f)
105−
106−-- |
107−-- Run a computation in the Unify monad, failing with an error, or succeeding with a return value and the new next unification variable
108−--
109−runUnify :: UnifyState t -> UnifyT t m a -> m (a, UnifyState t)
110−runUnify s = flip runStateT s . unUnify
111−
112−-- |
113−-- Substitute a single unification variable
114−--
115−substituteOne :: (Partial t) => Unknown -> t -> Substitution t
116−substituteOne u t = Substitution $ M.singleton u t
117−
118−-- |
119−-- Replace a unification variable with the specified value in the current substitution
120−--
121−(=:=) :: (UnificationError t e, Monad m, MonadError e m, Unifiable m t) => Unknown -> t -> UnifyT t m ()
122−(=:=) u t' = do
123− st <- UnifyT get
124− let sub = unifyCurrentSubstitution st
125− let t = sub $? t'
126− occursCheck u t
127− let current = sub $? unknown u
128− case isUnknown current of
129− Just u1 | u1 == u -> return ()
130− _ -> current =?= t
131− UnifyT $ modify $ \s -> s { unifyCurrentSubstitution = substituteOne u t <> unifyCurrentSubstitution s }
132−
133−-- |
134−-- Perform the occurs check, to make sure a unification variable does not occur inside a value
135−--
136−occursCheck :: (UnificationError t e, Monad m, MonadError e m, Partial t) => Unknown -> t -> UnifyT t m ()
137−occursCheck u t =
138− case isUnknown t of
139− Nothing -> when (u `elem` unknowns t) $ UnifyT . lift . throwError $ occursCheckFailed t
140− _ -> return ()
141−
142−-- |
143−-- Generate a fresh untyped unification variable
144−--
145−fresh' :: (Monad m) => UnifyT t m Unknown
146−fresh' = do
147− st <- UnifyT get
148− UnifyT $ modify $ \s -> s { unifyNextVar = succ (unifyNextVar s) }
149− return $ unifyNextVar st
150−
151−-- |
152−-- Generate a fresh unification variable at a specific type
153−--
154−fresh :: (Monad m, Partial t) => UnifyT t m t
155−fresh = do
156− u <- fresh'
157− return $ unknown u
158−
159−
160−
src/Language/PureScript.hsdeleted−49
@@ -1,49 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- The main compiler module
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DataKinds #-}
17−{-# LANGUAGE FlexibleContexts #-}
18−{-# LANGUAGE RecordWildCards #-}
19−{-# LANGUAGE ScopedTypeVariables #-}
20−
21−module Language.PureScript
22− ( module P
23− , version
24− ) where
25−
26−import Data.Version (Version)
27−
28−import Language.PureScript.AST as P
29−import Language.PureScript.Comments as P
30−import Language.PureScript.Environment as P
31−import Language.PureScript.Errors as P hiding (indent)
32−import Language.PureScript.Kinds as P
33−import Language.PureScript.Linter as P
34−import Language.PureScript.Make as P
35−import Language.PureScript.ModuleDependencies as P
36−import Language.PureScript.Names as P
37−import Language.PureScript.Options as P
38−import Language.PureScript.Parser as P
39−import Language.PureScript.Pretty as P
40−import Language.PureScript.Renamer as P
41−import Language.PureScript.Sugar as P
42−import Control.Monad.Supply as P
43−import Language.PureScript.TypeChecker as P
44−import Language.PureScript.Types as P
45−
46−import qualified Paths_purescript as Paths
47−
48−version :: Version
49−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−92
@@ -1,92 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.Binders
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Case binders
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−
17−module Language.PureScript.AST.Binders where
18−
19−import qualified Data.Data as D
20−
21−import Language.PureScript.AST.SourcePos
22−import Language.PureScript.Names
23−import Language.PureScript.Comments
24−import Language.PureScript.Types
25−
26−-- |
27−-- Data type for binders
28−--
29−data Binder
30− -- |
31− -- Wildcard binder
32− --
33− = NullBinder
34− -- |
35− -- A binder which matches a boolean literal
36− --
37− | BooleanBinder Bool
38− -- |
39− -- A binder which matches a string literal
40− --
41− | StringBinder String
42− -- |
43− -- A binder which matches a character literal
44− --
45− | CharBinder Char
46− -- |
47− -- A binder which matches a numeric literal
48− --
49− | NumberBinder (Either Integer Double)
50− -- |
51− -- A binder which binds an identifier
52− --
53− | VarBinder Ident
54− -- |
55− -- A binder which matches a data constructor
56− --
57− | ConstructorBinder (Qualified ProperName) [Binder]
58− -- |
59− -- A binder which matches a record and binds its properties
60− --
61− | ObjectBinder [(String, Binder)]
62− -- |
63− -- A binder which matches an array and binds its elements
64− --
65− | ArrayBinder [Binder]
66− -- |
67− -- A binder which binds its input to an identifier
68− --
69− | NamedBinder Ident Binder
70− -- |
71− -- A binder with source position information
72− --
73− | PositionedBinder SourceSpan [Comment] Binder
74− -- |
75− -- A binder with a type annotation
76− --
77− | TypedBinder Type Binder deriving (Show, Read, Eq, D.Data, D.Typeable)
78−
79−-- |
80−-- Collect all names introduced in binders in an expression
81−--
82−binderNames :: Binder -> [Ident]
83−binderNames = go []
84− where
85− go ns (VarBinder name) = name : ns
86− go ns (ConstructorBinder _ bs) = foldl go ns bs
87− go ns (ObjectBinder bs) = foldl go ns (map snd bs)
88− go ns (ArrayBinder bs) = foldl go ns bs
89− go ns (NamedBinder name b) = go (name : ns) b
90− go ns (PositionedBinder _ _ b) = go ns b
91− go ns (TypedBinder _ b) = go ns b
92− go ns _ = ns
src/Language/PureScript/AST/Declarations.hsdeleted−438
@@ -1,438 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.AST.Declarations
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−-- | Data types for modules and declarations
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE TemplateHaskell #-}
18−{-# LANGUAGE CPP #-}
19−
20−module Language.PureScript.AST.Declarations where
21−
22−import Data.Aeson.TH
23−
24−import qualified Data.Data as D
25−import qualified Data.Map as M
26−
27−import Control.Monad.Identity
28−
29−#if __GLASGOW_HASKELL__ < 710
30−import Control.Applicative
31−#endif
32−
33−import Language.PureScript.AST.Binders
34−import Language.PureScript.AST.Operators
35−import Language.PureScript.AST.SourcePos
36−import Language.PureScript.Types
37−import Language.PureScript.Names
38−import Language.PureScript.Kinds
39−import Language.PureScript.TypeClassDictionaries
40−import Language.PureScript.Comments
41−import Language.PureScript.Environment
42−
43−-- |
44−-- A module declaration, consisting of comments about the module, a module name,
45−-- a list of declarations, and a list of the declarations that are
46−-- explicitly exported. If the export list is Nothing, everything is exported.
47−--
48−data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, Read, D.Data, D.Typeable)
49−
50−-- | Return a module's name.
51−getModuleName :: Module -> ModuleName
52−getModuleName (Module _ _ name _ _) = name
53−
54−-- |
55−-- An item in a list of explicit imports or exports
56−--
57−data DeclarationRef
58− -- |
59− -- A type constructor with data constructors
60− --
61− = TypeRef ProperName (Maybe [ProperName])
62− -- |
63− -- A value
64− --
65− | ValueRef Ident
66− -- |
67− -- A type class
68− --
69− | TypeClassRef ProperName
70− -- |
71− -- A type class instance, created during typeclass desugaring (name, class name, instance types)
72− --
73− | TypeInstanceRef Ident
74− -- |
75− -- A module, in its entirety
76− --
77− | ModuleRef ModuleName
78− -- |
79− -- A declaration reference with source position information
80− --
81− | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
82− deriving (Show, Read, D.Data, D.Typeable)
83−
84−instance Eq DeclarationRef where
85− (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
86− (ValueRef name) == (ValueRef name') = name == name'
87− (TypeClassRef name) == (TypeClassRef name') = name == name'
88− (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
89− (ModuleRef name) == (ModuleRef name') = name == name'
90− (PositionedDeclarationRef _ _ r) == r' = r == r'
91− r == (PositionedDeclarationRef _ _ r') = r == r'
92− _ == _ = False
93−
94−isModuleRef :: DeclarationRef -> Bool
95−isModuleRef (ModuleRef _) = True
96−isModuleRef _ = False
97−
98−-- |
99−-- The data type which specifies type of import declaration
100−--
101−data ImportDeclarationType
102− -- |
103− -- An import with no explicit list: `import M`
104− --
105− = Implicit
106− -- |
107− -- An import with an explicit list of references to import: `import M (foo)`
108− --
109− | Explicit [DeclarationRef]
110− -- |
111− -- An import with a list of references to hide: `import M hiding (foo)`
112− --
113− | Hiding [DeclarationRef]
114− deriving (Show, Read, D.Data, D.Typeable)
115−
116−-- |
117−-- The data type of declarations
118−--
119−data Declaration
120− -- |
121− -- A data type declaration (data or newtype, name, arguments, data constructors)
122− --
123− = DataDeclaration DataDeclType ProperName [(String, Maybe Kind)] [(ProperName, [Type])]
124− -- |
125− -- A minimal mutually recursive set of data type declarations
126− --
127− | DataBindingGroupDeclaration [Declaration]
128− -- |
129− -- A type synonym declaration (name, arguments, type)
130− --
131− | TypeSynonymDeclaration ProperName [(String, Maybe Kind)] Type
132− -- |
133− -- A type declaration for a value (name, ty)
134− --
135− | TypeDeclaration Ident Type
136− -- |
137− -- A value declaration (name, top-level binders, optional guard, value)
138− --
139− | ValueDeclaration Ident NameKind [Binder] (Either [(Guard, Expr)] Expr)
140− -- |
141− -- A minimal mutually recursive set of value declarations
142− --
143− | BindingGroupDeclaration [(Ident, NameKind, Expr)]
144− -- |
145− -- A foreign import declaration (name, type)
146− --
147− | ExternDeclaration Ident Type
148− -- |
149− -- A data type foreign import (name, kind)
150− --
151− | ExternDataDeclaration ProperName Kind
152− -- |
153− -- A fixity declaration (fixity data, operator name)
154− --
155− | FixityDeclaration Fixity String
156− -- |
157− -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
158− --
159− | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
160− -- |
161− -- A type class declaration (name, argument, implies, member declarations)
162− --
163− | TypeClassDeclaration ProperName [(String, Maybe Kind)] [Constraint] [Declaration]
164− -- |
165− -- A type instance declaration (name, dependencies, class name, instance types, member
166− -- declarations)
167− --
168− | TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] TypeInstanceBody
169− -- |
170− -- A declaration with source position information
171− --
172− | PositionedDeclaration SourceSpan [Comment] Declaration
173− deriving (Show, Read, D.Data, D.Typeable)
174−
175−-- | The members of a type class instance declaration
176−data TypeInstanceBody
177− -- | This is a derived instance
178− = DerivedInstance
179− -- | This is a regular (explicit) instance
180− | ExplicitInstance [Declaration]
181− deriving (Show, Read, D.Data, D.Typeable)
182−
183−mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody
184−mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)
185−
186−-- | A traversal for TypeInstanceBody
187−traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody
188−traverseTypeInstanceBody _ DerivedInstance = pure DerivedInstance
189−traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds
190−
191−-- |
192−-- Test if a declaration is a value declaration
193−--
194−isValueDecl :: Declaration -> Bool
195−isValueDecl ValueDeclaration{} = True
196−isValueDecl (PositionedDeclaration _ _ d) = isValueDecl d
197−isValueDecl _ = False
198−
199−-- |
200−-- Test if a declaration is a data type or type synonym declaration
201−--
202−isDataDecl :: Declaration -> Bool
203−isDataDecl DataDeclaration{} = True
204−isDataDecl TypeSynonymDeclaration{} = True
205−isDataDecl (PositionedDeclaration _ _ d) = isDataDecl d
206−isDataDecl _ = False
207−
208−-- |
209−-- Test if a declaration is a module import
210−--
211−isImportDecl :: Declaration -> Bool
212−isImportDecl ImportDeclaration{} = True
213−isImportDecl (PositionedDeclaration _ _ d) = isImportDecl d
214−isImportDecl _ = False
215−
216−-- |
217−-- Test if a declaration is a data type foreign import
218−--
219−isExternDataDecl :: Declaration -> Bool
220−isExternDataDecl ExternDataDeclaration{} = True
221−isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
222−isExternDataDecl _ = False
223−
224−-- |
225−-- Test if a declaration is a fixity declaration
226−--
227−isFixityDecl :: Declaration -> Bool
228−isFixityDecl FixityDeclaration{} = True
229−isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
230−isFixityDecl _ = False
231−
232−-- |
233−-- Test if a declaration is a foreign import
234−--
235−isExternDecl :: Declaration -> Bool
236−isExternDecl ExternDeclaration{} = True
237−isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
238−isExternDecl _ = False
239−
240−-- |
241−-- Test if a declaration is a type class instance declaration
242−--
243−isTypeClassInstanceDeclaration :: Declaration -> Bool
244−isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True
245−isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d
246−isTypeClassInstanceDeclaration _ = False
247−
248−-- |
249−-- Test if a declaration is a type class declaration
250−--
251−isTypeClassDeclaration :: Declaration -> Bool
252−isTypeClassDeclaration TypeClassDeclaration{} = True
253−isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d
254−isTypeClassDeclaration _ = False
255−
256−-- |
257−-- Recursively flatten data binding groups in the list of declarations
258−flattenDecls :: [Declaration] -> [Declaration]
259−flattenDecls = concatMap flattenOne
260− where flattenOne :: Declaration -> [Declaration]
261− flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls
262− flattenOne d = [d]
263−
264−-- |
265−-- A guard is just a boolean-valued expression that appears alongside a set of binders
266−--
267−type Guard = Expr
268−
269−-- |
270−-- Data type for expressions and terms
271−--
272−data Expr
273− -- |
274− -- A numeric literal
275− --
276− = NumericLiteral (Either Integer Double)
277− -- |
278− -- A string literal
279− --
280− | StringLiteral String
281− -- |
282− -- A character literal
283− --
284− | CharLiteral Char
285− -- |
286− -- A boolean literal
287− --
288− | BooleanLiteral Bool
289− -- |
290− -- A prefix -, will be desugared
291− --
292− | UnaryMinus Expr
293− -- |
294− -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
295− -- will be removed.
296− --
297− | BinaryNoParens Expr Expr Expr
298− -- |
299− -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor
300− -- will be removed.
301− --
302− | Parens Expr
303− -- |
304− -- Operator section. This will be removed during desugaring and replaced with a partially applied
305− -- operator or lambda to flip the arguments.
306− --
307− | OperatorSection Expr (Either Expr Expr)
308− -- |
309− -- An array literal
310− --
311− | ArrayLiteral [Expr]
312− -- |
313− -- An object literal
314− --
315− | ObjectLiteral [(String, Expr)]
316− -- |
317− -- An object constructor (object literal with underscores). This will be removed during
318− -- desugaring and expanded into a lambda that returns an object literal.
319− --
320− | ObjectConstructor [(String, Maybe Expr)]
321− -- |
322− -- An object property getter (e.g. `_.x`). This will be removed during
323− -- desugaring and expanded into a lambda that reads a property from an object.
324− --
325− | ObjectGetter String
326− -- |
327− -- An record property accessor expression
328− --
329− | Accessor String Expr
330− -- |
331− -- Partial record update
332− --
333− | ObjectUpdate Expr [(String, Expr)]
334− -- |
335− -- Partial record updater. This will be removed during desugaring and
336− -- expanded into a lambda that returns an object update.
337− --
338− | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]
339− -- |
340− -- Function introduction
341− --
342− | Abs (Either Ident Binder) Expr
343− -- |
344− -- Function application
345− --
346− | App Expr Expr
347− -- |
348− -- Variable
349− --
350− | Var (Qualified Ident)
351− -- |
352− -- Conditional (if-then-else expression)
353− --
354− | IfThenElse Expr Expr Expr
355− -- |
356− -- A data constructor
357− --
358− | Constructor (Qualified ProperName)
359− -- |
360− -- A case expression. During the case expansion phase of desugaring, top-level binders will get
361− -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
362− --
363− | Case [Expr] [CaseAlternative]
364− -- |
365− -- A value with a type annotation
366− --
367− | TypedValue Bool Expr Type
368− -- |
369− -- A let binding
370− --
371− | Let [Declaration] Expr
372− -- |
373− -- A do-notation block
374− --
375− | Do [DoNotationElement]
376− -- |
377− -- An application of a typeclass dictionary constructor. The value should be
378− -- an ObjectLiteral.
379− --
380− | TypeClassDictionaryConstructorApp (Qualified ProperName) Expr
381− -- |
382− -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
383− -- placeholders will be replaced with actual expressions representing type classes dictionaries which
384− -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
385− -- at superclass implementations when searching for a dictionary, the type class name and
386− -- instance type, and the type class dictionaries in scope.
387− --
388− | TypeClassDictionary Constraint (M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))
389− -- |
390− -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
391− --
392− | TypeClassDictionaryAccessor (Qualified ProperName) Ident
393− -- |
394− -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
395− --
396− | SuperClassDictionary (Qualified ProperName) [Type]
397− -- |
398− -- A value with source position information
399− --
400− | PositionedValue SourceSpan [Comment] Expr deriving (Show, Read, D.Data, D.Typeable)
401−
402−-- |
403−-- An alternative in a case statement
404−--
405−data CaseAlternative = CaseAlternative
406− { -- |
407− -- A collection of binders with which to match the inputs
408− --
409− caseAlternativeBinders :: [Binder]
410− -- |
411− -- The result expression or a collect of guarded expressions
412− --
413− , caseAlternativeResult :: Either [(Guard, Expr)] Expr
414− } deriving (Show, Read, D.Data, D.Typeable)
415−
416−-- |
417−-- A statement in a do-notation block
418−--
419−data DoNotationElement
420− -- |
421− -- A monadic value without a binder
422− --
423− = DoNotationValue Expr
424− -- |
425− -- A monadic value with a binder
426− --
427− | DoNotationBind Binder Expr
428− -- |
429− -- A let statement, i.e. a pure value with a binder
430− --
431− | DoNotationLet [Declaration]
432− -- |
433− -- A do notation element with source position information
434− --
435− | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement deriving (Show, Read, D.Data, D.Typeable)
436−
437−$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)
438−$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)
src/Language/PureScript/AST/Exported.hsdeleted−136
@@ -1,136 +0,0 @@
1−
2−module Language.PureScript.AST.Exported (
3− exportedDeclarations,
4− isExported
5−) where
6−
7−import Control.Category ((>>>))
8−import Data.Maybe (mapMaybe)
9−
10−import Language.PureScript.AST.Declarations
11−import Language.PureScript.Types
12−import Language.PureScript.Names
13−
14−-- |
15−-- Return a list of all declarations which are exported from a module.
16−-- This function descends into data declarations to filter out unexported
17−-- data constructors, and also filters out type instance declarations if
18−-- they refer to classes or types which are not themselves exported.
19−--
20−-- Note that this function assumes that the module has already had its imports
21−-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
22−-- produce incorrect results if this is not the case - for example, type class
23−-- instances will be incorrectly removed in some cases.
24−--
25−exportedDeclarations :: Module -> [Declaration]
26−exportedDeclarations (Module _ _ _ decls exps) = go decls
27− where
28− go = flattenDecls
29− >>> filter (isExported exps)
30− >>> map (filterDataConstructors exps)
31− >>> filterInstances exps
32−
33−-- |
34−-- Filter out all data constructors from a declaration which are not exported.
35−-- If the supplied declaration is not a data declaration, this function returns
36−-- it unchanged.
37−--
38−filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
39−filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =
40− DataDeclaration dType tyName tyArgs $
41− filter (isDctorExported tyName exps . fst) dctors
42−filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =
43− PositionedDeclaration srcSpan coms (filterDataConstructors exps d)
44−filterDataConstructors _ other = other
45−
46−-- |
47−-- Filter out all the type instances from a list of declarations which
48−-- reference a type or type class which is both local and not exported.
49−--
50−-- Note that this function assumes that the module has already had its imports
51−-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
52−-- produce incorrect results if this is not the case - for example, type class
53−-- instances will be incorrectly removed in some cases.
54−--
55−filterInstances :: Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
56−filterInstances Nothing = id
57−filterInstances (Just exps) =
58− let refs = mapMaybe typeName exps ++ mapMaybe typeClassName exps
59− in filter (all (visibleOutside refs) . typeInstanceConstituents)
60− where
61− -- Given a Qualified ProperName, and a list of all exported types and type
62− -- classes, returns whether the supplied Qualified ProperName is visible
63− -- outside this module. This is true if one of the following hold:
64− --
65− -- * the name is defined in the same module and is exported,
66− -- * the name is defined in a different module (and must be exported from
67− -- that module; the code would fail to compile otherwise).
68− visibleOutside _ (Qualified (Just _) _) = True
69− visibleOutside refs (Qualified Nothing n) = n `elem` refs
70−
71− typeName (TypeRef n _) = Just n
72− typeName (PositionedDeclarationRef _ _ r) = typeName r
73− typeName _ = Nothing
74−
75− typeClassName (TypeClassRef n) = Just n
76− typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r
77− typeClassName _ = Nothing
78−
79−-- |
80−-- Get all type and type class names referenced by a type instance declaration.
81−--
82−typeInstanceConstituents :: Declaration -> [Qualified ProperName]
83−typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =
84− className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
85− where
86−
87− fromConstraint (name, tys') = name : concatMap fromType tys'
88− fromType = everythingOnTypes (++) go
89−
90− -- Note that type synonyms are disallowed in instance declarations, so
91− -- we don't need to handle them here.
92− go (TypeConstructor n) = [n]
93− go (ConstrainedType cs _) = concatMap fromConstraint cs
94− go _ = []
95−
96−typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d
97−typeInstanceConstituents _ = []
98−
99−
100−-- |
101−-- Test if a declaration is exported, given a module's export list. Note that
102−-- this function does not account for type instance declarations of
103−-- non-exported types, or non-exported data constructors. Therefore, you should
104−-- prefer 'exportedDeclarations' to this function, where possible.
105−--
106−isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
107−isExported Nothing _ = True
108−isExported _ TypeInstanceDeclaration{} = True
109−isExported exps (PositionedDeclaration _ _ d) = isExported exps d
110−isExported (Just exps) decl = any (matches decl) exps
111− where
112− matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
113− matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
114− matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'
115− matches (FixityDeclaration _ name) (ValueRef ident') = name == runIdent ident'
116− matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
117− matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
118− matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
119− matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
120−
121− matches (PositionedDeclaration _ _ d) r = d `matches` r
122− matches d (PositionedDeclarationRef _ _ r) = d `matches` r
123− matches _ _ = False
124−
125−-- |
126−-- Test if a data constructor for a given type is exported, given a module's
127−-- export list. Prefer 'exportedDeclarations' to this function, where possible.
128−--
129−isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
130−isDctorExported _ Nothing _ = True
131−isDctorExported ident (Just exps) ctor = test `any` exps
132− where
133− test (PositionedDeclarationRef _ _ d) = test d
134− test (TypeRef ident' Nothing) = ident == ident'
135− test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
136− test _ = False
src/Language/PureScript/AST/Operators.hsdeleted−60
@@ -1,60 +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−-- |
25−-- A precedence level for an infix operator
26−--
27−type Precedence = Integer
28−
29−-- |
30−-- Associativity for infix operators
31−--
32−data Associativity = Infixl | Infixr | Infix deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
33−
34−showAssoc :: Associativity -> String
35−showAssoc Infixl = "infixl"
36−showAssoc Infixr = "infixr"
37−showAssoc Infix = "infix"
38−
39−readAssoc :: String -> Associativity
40−readAssoc "infixl" = Infixl
41−readAssoc "infixr" = Infixr
42−readAssoc "infix" = Infix
43−readAssoc _ = error "readAssoc: no parse"
44−
45−instance A.ToJSON Associativity where
46− toJSON = A.toJSON . showAssoc
47−
48−instance A.FromJSON Associativity where
49− parseJSON = fmap readAssoc . A.parseJSON
50−
51−-- |
52−-- Fixity data for infix operators
53−--
54−data Fixity = Fixity Associativity Precedence deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
55−
56−instance A.ToJSON Fixity where
57− toJSON (Fixity associativity precedence) =
58− A.object [ "associativity" .= associativity
59− , "precedence" .= precedence
60− ]
src/Language/PureScript/AST/SourcePos.hsdeleted−98
@@ -1,98 +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 CPP #-}
16−{-# LANGUAGE DeriveDataTypeable #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# LANGUAGE RecordWildCards #-}
19−{-# LANGUAGE OverloadedStrings #-}
20−
21−module Language.PureScript.AST.SourcePos where
22−
23−import qualified Data.Data as D
24−import Data.Aeson ((.=), (.:))
25−import qualified Data.Aeson as A
26−
27−#if __GLASGOW_HASKELL__ < 710
28−import Control.Applicative
29−#endif
30−
31−-- |
32−-- Source position information
33−--
34−data SourcePos = SourcePos
35− { -- |
36− -- Line number
37− --
38− sourcePosLine :: Int
39− -- |
40− -- Column number
41− --
42− , sourcePosColumn :: Int
43− } deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
44−
45−displaySourcePos :: SourcePos -> String
46−displaySourcePos sp =
47− "line " ++ show (sourcePosLine sp) ++
48− ", column " ++ show (sourcePosColumn sp)
49−
50−instance A.ToJSON SourcePos where
51− toJSON SourcePos{..} =
52− A.toJSON [sourcePosLine, sourcePosColumn]
53−
54−instance A.FromJSON SourcePos where
55− parseJSON arr = do
56− [line, col] <- A.parseJSON arr
57− return $ SourcePos line col
58−
59−data SourceSpan = SourceSpan
60− { -- |
61− -- Source name
62− --
63− spanName :: String
64− -- |
65− -- Start of the span
66− --
67− , spanStart :: SourcePos
68− -- End of the span
69− --
70− , spanEnd :: SourcePos
71− } deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
72−
73−displayStartEndPos :: SourceSpan -> String
74−displayStartEndPos sp =
75− displaySourcePos (spanStart sp) ++ " - " ++
76− displaySourcePos (spanEnd sp)
77−
78−displaySourceSpan :: SourceSpan -> String
79−displaySourceSpan sp =
80− spanName sp ++ " " ++
81− displayStartEndPos sp
82−
83−instance A.ToJSON SourceSpan where
84− toJSON SourceSpan{..} =
85− A.object [ "name" .= spanName
86− , "start" .= spanStart
87− , "end" .= spanEnd
88− ]
89−
90−instance A.FromJSON SourceSpan where
91− parseJSON = A.withObject "SourceSpan" $ \o ->
92− SourceSpan <$>
93− o .: "name" <*>
94− o .: "start" <*>
95− o .: "end"
96−
97−internalModuleSourceSpan :: String -> SourceSpan
98−internalModuleSourceSpan name = SourceSpan name (SourcePos 0 0) (SourcePos 0 0)
src/Language/PureScript/AST/Traversals.hsdeleted−415
@@ -1,415 +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−{-# LANGUAGE CPP #-}
16−
17−module Language.PureScript.AST.Traversals where
18−
19−#if __GLASGOW_HASKELL__ < 710
20−import Data.Monoid (Monoid(..), mconcat)
21−#endif
22−import Data.Maybe (mapMaybe)
23−#if __GLASGOW_HASKELL__ < 710
24−import Data.Traversable (traverse)
25−#endif
26−
27−#if __GLASGOW_HASKELL__ < 710
28−import Control.Applicative
29−#endif
30−import Control.Monad
31−import Control.Arrow ((***), (+++), second)
32−
33−import Language.PureScript.AST.Binders
34−import Language.PureScript.AST.Declarations
35−import Language.PureScript.Types
36−import Language.PureScript.Traversals
37−
38−everywhereOnValues :: (Declaration -> Declaration) ->
39− (Expr -> Expr) ->
40− (Binder -> Binder) ->
41− (Declaration -> Declaration, Expr -> Expr, Binder -> Binder)
42−everywhereOnValues f g h = (f', g', h')
43− where
44− f' :: Declaration -> Declaration
45− f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))
46− f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) ((map (g' *** g') +++ g') val))
47− f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
48− f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))
49− f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (mapTypeInstanceBody (map f') ds))
50− f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))
51− f' other = f other
52−
53− g' :: Expr -> Expr
54− g' (UnaryMinus v) = g (UnaryMinus (g' v))
55− g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
56− g' (Parens v) = g (Parens (g' v))
57− g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))
58− g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))
59− g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))
60− g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))
61− g' (ObjectConstructor vs) = g (ObjectConstructor (map (second (fmap g')) vs))
62− g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
63− g' (Accessor prop v) = g (Accessor prop (g' v))
64− g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))
65− g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))
66− g' (Abs name v) = g (Abs name (g' v))
67− g' (App v1 v2) = g (App (g' v1) (g' v2))
68− g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))
69− g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))
70− g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
71− g' (Let ds v) = g (Let (map f' ds) (g' v))
72− g' (Do es) = g (Do (map handleDoNotationElement es))
73− g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))
74− g' other = g other
75−
76− h' :: Binder -> Binder
77− h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))
78− h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))
79− h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))
80− h' (NamedBinder name b) = h (NamedBinder name (h' b))
81− h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
82− h' (TypedBinder t b) = h (TypedBinder t (h' b))
83− h' other = h other
84−
85− handleCaseAlternative :: CaseAlternative -> CaseAlternative
86− handleCaseAlternative ca =
87− ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
88− , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
89− }
90−
91− handleDoNotationElement :: DoNotationElement -> DoNotationElement
92− handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)
93− handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)
94− handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)
95− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)
96−
97−everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>
98− (Declaration -> m Declaration) ->
99− (Expr -> m Expr) ->
100− (Binder -> m Binder) ->
101− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
102−everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
103− where
104− f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f' <=< f) ds
105− f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h' <=< h) bs <*> eitherM (mapM (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
106− f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
107− f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f' <=< f) ds
108− f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds
109− f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')
110− f' other = f other
111−
112− g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
113− g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
114− g' (Parens v) = Parens <$> (g v >>= g')
115− g' (OperatorSection op (Left v)) = OperatorSection <$> (g op >>= g') <*> (Left <$> (g v >>= g'))
116− g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))
117− g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs
118− g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs
119− g' (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g' <=< g)) vs
120− g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
121− g' (Accessor prop v) = Accessor prop <$> (g v >>= g')
122− g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs
123− g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> mapM (sndM $ maybeM (g' <=< g)) vs
124− g' (Abs name v) = Abs name <$> (g v >>= g')
125− g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')
126− g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')
127− g' (Case vs alts) = Case <$> mapM (g' <=< g) vs <*> mapM handleCaseAlternative alts
128− g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
129− g' (Let ds v) = Let <$> mapM (f' <=< f) ds <*> (g v >>= g')
130− g' (Do es) = Do <$> mapM handleDoNotationElement es
131− g' (PositionedValue pos com v) = PositionedValue pos com <$> (g v >>= g')
132− g' other = g other
133−
134− h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs
135− h' (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h' <=< h)) bs
136− h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs
137− h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
138− h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
139− h' (TypedBinder t b) = TypedBinder t <$> (h b >>= h')
140− h' other = h other
141−
142− handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM (h' <=< h) bs
143− <*> eitherM (mapM (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
144−
145− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v
146− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v
147− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM (f' <=< f) ds
148− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
149−
150−everywhereOnValuesM :: (Functor m, Applicative m, Monad m) =>
151− (Declaration -> m Declaration) ->
152− (Expr -> m Expr) ->
153− (Binder -> m Binder) ->
154− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
155−everywhereOnValuesM f g h = (f', g', h')
156− where
157− f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> mapM f' ds) >>= f
158− f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> mapM h' bs <*> eitherM (mapM (pairM g' g')) g' val) >>= f
159− f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f
160− f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> mapM f' ds) >>= f
161− f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (mapM f') ds) >>= f
162− f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f
163− f' other = f other
164−
165− g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
166− g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
167− g' (Parens v) = (Parens <$> g' v) >>= g
168− g' (OperatorSection op (Left v)) = (OperatorSection <$> g' op <*> (Left <$> g' v)) >>= g
169− g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g
170− g' (ArrayLiteral vs) = (ArrayLiteral <$> mapM g' vs) >>= g
171− g' (ObjectLiteral vs) = (ObjectLiteral <$> mapM (sndM g') vs) >>= g
172− g' (ObjectConstructor vs) = (ObjectConstructor <$> mapM (sndM $ maybeM g') vs) >>= g
173− g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
174− g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g
175− g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g
176− g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> mapM (sndM $ maybeM g') vs) >>= g
177− g' (Abs name v) = (Abs name <$> g' v) >>= g
178− g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g
179− g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g
180− g' (Case vs alts) = (Case <$> mapM g' vs <*> mapM handleCaseAlternative alts) >>= g
181− g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
182− g' (Let ds v) = (Let <$> mapM f' ds <*> g' v) >>= g
183− g' (Do es) = (Do <$> mapM handleDoNotationElement es) >>= g
184− g' (PositionedValue pos com v) = (PositionedValue pos com <$> g' v) >>= g
185− g' other = g other
186−
187− h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h
188− h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h
189− h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h
190− h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
191− h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
192− h' (TypedBinder t b) = (TypedBinder t <$> h' b) >>= h
193− h' other = h other
194−
195− handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM h' bs
196− <*> eitherM (mapM (pairM g' g')) g' val
197−
198− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v
199− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v
200− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM f' ds
201− handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
202−
203−everythingOnValues :: (r -> r -> r) ->
204− (Declaration -> r) ->
205− (Expr -> r) ->
206− (Binder -> r) ->
207− (CaseAlternative -> r) ->
208− (DoNotationElement -> r) ->
209− (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
210−everythingOnValues (<>) f g h i j = (f', g', h', i', j')
211− where
212− f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)
213− f' d@(ValueDeclaration _ _ bs (Right val)) = foldl (<>) (f d) (map h' bs) <> g' val
214− f' d@(ValueDeclaration _ _ bs (Left gs)) = foldl (<>) (f d) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
215− f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)
216− f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)
217− f' d@(TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (map f' ds)
218− f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1
219− f' d = f d
220−
221− g' v@(UnaryMinus v1) = g v <> g' v1
222− g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2
223− g' v@(Parens v1) = g v <> g' v1
224− g' v@(OperatorSection op (Left v1)) = g v <> g' op <> g' v1
225− g' v@(OperatorSection op (Right v1)) = g v <> g' op <> g' v1
226− g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)
227− g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)
228− g' v@(ObjectConstructor vs) = foldl (<>) (g v) (map g' (mapMaybe snd vs))
229− g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
230− g' v@(Accessor _ v1) = g v <> g' v1
231− g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
232− g' v@(ObjectUpdater obj vs) = foldl (<>) (maybe (g v) (\x -> g v <> g' x) obj) (map g' (mapMaybe snd vs))
233− g' v@(Abs _ v1) = g v <> g' v1
234− g' v@(App v1 v2) = g v <> g' v1 <> g' v2
235− g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3
236− g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
237− g' v@(TypedValue _ v1 _) = g v <> g' v1
238− g' v@(Let ds v1) = foldl (<>) (g v) (map f' ds) <> g' v1
239− g' v@(Do es) = foldl (<>) (g v) (map j' es)
240− g' v@(PositionedValue _ _ v1) = g v <> g' v1
241− g' v = g v
242−
243− h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)
244− h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)
245− h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)
246− h' b@(NamedBinder _ b1) = h b <> h' b1
247− h' b@(PositionedBinder _ _ b1) = h b <> h' b1
248− h' b@(TypedBinder _ b1) = h b <> h' b1
249− h' b = h b
250−
251− i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
252− i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
253−
254− j' e@(DoNotationValue v) = j e <> g' v
255− j' e@(DoNotationBind b v) = j e <> h' b <> g' v
256− j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)
257− j' e@(PositionedDoNotationElement _ _ e1) = j e <> j' e1
258−
259−everythingWithContextOnValues ::
260− s ->
261− r ->
262− (r -> r -> r) ->
263− (s -> Declaration -> (s, r)) ->
264− (s -> Expr -> (s, r)) ->
265− (s -> Binder -> (s, r)) ->
266− (s -> CaseAlternative -> (s, r)) ->
267− (s -> DoNotationElement -> (s, r)) ->
268− ( Declaration -> r
269− , Expr -> r
270− , Binder -> r
271− , CaseAlternative -> r
272− , DoNotationElement -> r)
273−everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
274− where
275− f'' s d = let (s', r) = f s d in r <> f' s' d
276−
277− f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (map (f'' s) ds)
278− f' s (ValueDeclaration _ _ bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
279− f' s (ValueDeclaration _ _ bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
280− f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)
281− f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
282− f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (map (f'' s) ds)
283− f' s (PositionedDeclaration _ _ d1) = f'' s d1
284− f' _ _ = r0
285−
286− g'' s v = let (s', r) = g s v in r <> g' s' v
287−
288− g' s (UnaryMinus v1) = g'' s v1
289− g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
290− g' s (Parens v1) = g'' s v1
291− g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v
292− g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v
293− g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)
294− g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)
295− g' s (ObjectConstructor vs) = foldl (<>) r0 (map (g'' s) (mapMaybe snd vs))
296− g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
297− g' s (Accessor _ v1) = g'' s v1
298− g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)
299− g' s (ObjectUpdater obj vs) = foldl (<>) (maybe r0 (g'' s) obj) (map (g'' s) (mapMaybe snd vs))
300− g' s (Abs _ v1) = g'' s v1
301− g' s (App v1 v2) = g'' s v1 <> g'' s v2
302− g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
303− g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (map (g'' s) vs)) (map (i'' s) alts)
304− g' s (TypedValue _ v1 _) = g'' s v1
305− g' s (Let ds v1) = foldl (<>) r0 (map (f'' s) ds) <> g'' s v1
306− g' s (Do es) = foldl (<>) r0 (map (j'' s) es)
307− g' s (PositionedValue _ _ v1) = g'' s v1
308− g' _ _ = r0
309−
310− h'' s b = let (s', r) = h s b in r <> h' s' b
311−
312− h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)
313− h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)
314− h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
315− h' s (NamedBinder _ b1) = h'' s b1
316− h' s (PositionedBinder _ _ b1) = h'' s b1
317− h' s (TypedBinder _ b1) = h'' s b1
318− h' _ _ = r0
319−
320− i'' s ca = let (s', r) = i s ca in r <> i' s' ca
321−
322− i' s (CaseAlternative bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
323− i' s (CaseAlternative bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
324−
325− j'' s e = let (s', r) = j s e in r <> j' s' e
326−
327− j' s (DoNotationValue v) = g'' s v
328− j' s (DoNotationBind b v) = h'' s b <> g'' s v
329− j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
330− j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
331−
332−everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>
333− s ->
334− (s -> Declaration -> m (s, Declaration)) ->
335− (s -> Expr -> m (s, Expr)) ->
336− (s -> Binder -> m (s, Binder)) ->
337− (s -> CaseAlternative -> m (s, CaseAlternative)) ->
338− (s -> DoNotationElement -> m (s, DoNotationElement)) ->
339− ( Declaration -> m Declaration
340− , Expr -> m Expr
341− , Binder -> m Binder
342− , CaseAlternative -> m CaseAlternative
343− , DoNotationElement -> m DoNotationElement)
344−everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
345− where
346− f'' s = uncurry f' <=< f s
347−
348− f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f'' s) ds
349− f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h'' s) bs <*> eitherM (mapM (pairM (g'' s) (g'' s))) (g'' s) val
350− f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (thirdM (g'' s)) ds
351− f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f'' s) ds
352− f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (mapM (f'' s)) ds
353− f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1
354− f' _ other = return other
355−
356− g'' s = uncurry g' <=< g s
357−
358− g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
359− g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
360− g' s (Parens v) = Parens <$> g'' s v
361− g' s (OperatorSection op (Left v)) = OperatorSection <$> g'' s op <*> (Left <$> g'' s v)
362− g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)
363− g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs
364− g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs
365− g' s (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g'' s)) vs
366− g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v
367− g' s (Accessor prop v) = Accessor prop <$> g'' s v
368− g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs
369− g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> mapM (sndM $ maybeM (g'' s)) vs
370− g' s (Abs name v) = Abs name <$> g'' s v
371− g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
372− g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
373− g' s (Case vs alts) = Case <$> mapM (g'' s) vs <*> mapM (i'' s) alts
374− g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
375− g' s (Let ds v) = Let <$> mapM (f'' s) ds <*> g'' s v
376− g' s (Do es) = Do <$> mapM (j'' s) es
377− g' s (PositionedValue pos com v) = PositionedValue pos com <$> g'' s v
378− g' _ other = return other
379−
380− h'' s = uncurry h' <=< h s
381−
382− h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h'' s) bs
383− h' s (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h'' s)) bs
384− h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs
385− h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
386− h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
387− h' s (TypedBinder t b) = TypedBinder t <$> h'' s b
388− h' _ other = return other
389−
390− i'' s = uncurry i' <=< i s
391−
392− i' s (CaseAlternative bs val) = CaseAlternative <$> mapM (h'' s) bs <*> eitherM (mapM (pairM (g'' s) (g'' s))) (g'' s) val
393−
394− j'' s = uncurry j' <=< j s
395−
396− j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
397− j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
398− j' s (DoNotationLet ds) = DoNotationLet <$> mapM (f'' s) ds
399− j' s (PositionedDoNotationElement pos com e1) = PositionedDoNotationElement pos com <$> j'' s e1
400−
401−accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
402−accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
403− where
404− forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
405− forDecls (ExternDeclaration _ ty) = f ty
406− forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
407− forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
408− forDecls (TypeSynonymDeclaration _ _ ty) = f ty
409− forDecls (TypeDeclaration _ ty) = f ty
410− forDecls _ = mempty
411−
412− forValues (TypeClassDictionary (_, cs) _) = mconcat (map f cs)
413− forValues (SuperClassDictionary _ tys) = mconcat (map f tys)
414− forValues (TypedValue _ _ ty) = f ty
415− 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−{-# LANGUAGE RecordWildCards #-}
23−{-# LANGUAGE CPP #-}
24−
25−module Language.PureScript.Bundle (
26− bundle
27− , ModuleIdentifier(..)
28− , moduleName
29− , ModuleType(..)
30− , ErrorMessage(..)
31− , printErrorMessage
32−) where
33−
34−import Data.List (nub)
35−import Data.Maybe (mapMaybe, catMaybes)
36−import Data.Generics (everything, everywhere, mkQ, mkT)
37−import Data.Graph
38−import Data.Version (showVersion)
39−
40−import qualified Data.Set as S
41−
42−#if __GLASGOW_HASKELL__ < 710
43−import Control.Applicative
44−#endif
45−import Control.Monad
46−import Control.Monad.Error.Class
47−import Language.JavaScript.Parser
48−
49−import qualified Paths_purescript as Paths
50−
51−-- | The type of error messages. We separate generation and rendering of errors using a data
52−-- type, in case we need to match on error types later.
53−data ErrorMessage
54− = UnsupportedModulePath String
55− | InvalidTopLevel
56− | UnableToParseModule String
57− | UnsupportedExport
58− | ErrorInModule ModuleIdentifier ErrorMessage
59− deriving (Show, Read)
60−
61−-- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.
62−data ModuleType
63− = Regular
64− | Foreign
65− deriving (Show, Read, Eq, Ord)
66−
67−showModuleType :: ModuleType -> String
68−showModuleType Regular = "Regular"
69−showModuleType Foreign = "Foreign"
70−
71−-- | A module is identified by its module name and its type.
72−data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Read, Eq, Ord)
73−
74−moduleName :: ModuleIdentifier -> String
75−moduleName (ModuleIdentifier name _) = name
76−
77−-- | A piece of code is identified by its module and its name. These keys are used to label vertices
78−-- in the dependency graph.
79−type Key = (ModuleIdentifier, String)
80−
81−-- | An export is either a "regular export", which exports a name from the regular module we are in,
82−-- or a reexport of a declaration in the corresponding foreign module.
83−--
84−-- Regular exports are labelled, since they might re-export an operator with another name.
85−data ExportType
86− = RegularExport String
87− | ForeignReexport
88− deriving (Show, Read, Eq, Ord)
89−
90−-- | There are four types of module element we are interested in:
91−--
92−-- 1) Require statements
93−-- 2) Member declarations
94−-- 3) Export lists
95−-- 4) Everything else
96−--
97−-- Each is labelled with the original AST node which generated it, so that we can dump it back
98−-- into the output during codegen.
99−data ModuleElement
100− = Require JSNode String ModuleIdentifier
101− | Member JSNode Bool String [JSNode] [Key]
102− | ExportsList [(ExportType, String, JSNode, [Key])]
103− | Other JSNode
104− deriving (Show, Read)
105−
106−-- | A module is just a list of elements of the types listed above.
107−data Module = Module ModuleIdentifier [ModuleElement] deriving (Show, Read)
108−
109−-- | Prepare an error message for consumption by humans.
110−printErrorMessage :: ErrorMessage -> [String]
111−printErrorMessage (UnsupportedModulePath s) =
112− [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
113− , "The following file names are supported:"
114− , " 1) index.js (psc native modules)"
115− , " 2) foreign.js (psc foreign modules)"
116− ]
117−printErrorMessage InvalidTopLevel =
118− [ "Expected a list of source elements at the top level." ]
119−printErrorMessage (UnableToParseModule err) =
120− [ "The module could not be parsed:"
121− , err
122− ]
123−printErrorMessage UnsupportedExport =
124− [ "An export was unsupported. Exports can be defined in one of two ways: "
125− , " 1) exports.name = ..."
126− , " 2) exports = { ... }"
127− ]
128−printErrorMessage (ErrorInModule mid e) =
129− ("Error in module " ++ displayIdentifier mid ++ ":")
130− : ""
131− : map (" " ++) (printErrorMessage e)
132− where
133− displayIdentifier (ModuleIdentifier name ty) =
134− name ++ " (" ++ showModuleType ty ++ ")"
135−
136−-- | Unpack the node inside a JSNode. This is useful when pattern matching.
137−node :: JSNode -> Node
138−node (NN n) = n
139−node (NT n _ _) = n
140−
141−-- | Calculate the ModuleIdentifier which a require(...) statement imports.
142−checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier
143−checkImportPath "./foreign" m _ =
144− Just (ModuleIdentifier (moduleName m) Foreign)
145−checkImportPath name _ names
146− | name `S.member` names = Just (ModuleIdentifier name Regular)
147−checkImportPath _ _ _ = Nothing
148−
149−-- | Compute the dependencies of all elements in a module, and add them to the tree.
150−--
151−-- Members and exports can have dependencies. A dependency is of one of the following forms:
152−--
153−-- 1) module.name or member["name"]
154−--
155−-- where module was imported using
156−--
157−-- var module = require("Module.Name");
158−--
159−-- 2) name
160−--
161−-- where name is the name of a member defined in the current module.
162−withDeps :: Module -> Module
163−withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
164− where
165− -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
166− imports :: [(String, ModuleIdentifier)]
167− imports = mapMaybe toImport es
168− where
169− toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
170− toImport (Require _ nm mid) = Just (nm, mid)
171− toImport _ = Nothing
172−
173− -- | Collects all member names in scope, so that we can identify dependencies of the second type.
174− boundNames :: [String]
175− boundNames = mapMaybe toBoundName es
176− where
177− toBoundName :: ModuleElement -> Maybe String
178− toBoundName (Member _ _ nm _ _) = Just nm
179− toBoundName _ = Nothing
180−
181− -- | Calculate dependencies and add them to the current element.
182− expandDeps :: ModuleElement -> ModuleElement
183− expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))
184− expandDeps (ExportsList exps) = ExportsList (map expand exps)
185− where
186− expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
187− expandDeps other = other
188−
189− dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]
190− dependencies m = everything (++) (mkQ [] toReference)
191− where
192− toReference :: Node -> [(ModuleIdentifier, String)]
193− toReference (JSMemberDot [ mn ] _ nm)
194− | JSIdentifier mn' <- node mn
195− , JSIdentifier nm' <- node nm
196− , Just mid <- lookup mn' imports
197− = [(mid, nm')]
198− toReference (JSMemberSquare [ mn ] _ nm _)
199− | JSIdentifier mn' <- node mn
200− , JSExpression [ s ] <- node nm
201− , JSStringLiteral _ nm' <- node s
202− , Just mid <- lookup mn' imports
203− = [(mid, nm')]
204− toReference (JSIdentifier nm)
205− | nm `elem` boundNames
206− = [(m, nm)]
207− toReference _ = []
208−
209−-- | Attempt to create a Module from a Javascript AST.
210−--
211−-- Each type of module element is matched using pattern guards, and everything else is bundled into the
212−-- Other constructor.
213−toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module
214−toModule mids mid top
215− | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns
216− | otherwise = err InvalidTopLevel
217− where
218− err = throwError . ErrorInModule mid
219−
220− toModuleElement :: JSNode -> m ModuleElement
221− toModuleElement n
222− | JSVariables var [ varIntro ] _ <- node n
223− , JSLiteral "var" <- node var
224− , JSVarDecl impN [ eq, req, impP ] <- node varIntro
225− , JSIdentifier importName <- node impN
226− , JSLiteral "=" <- node eq
227− , JSIdentifier "require" <- node req
228− , JSArguments _ [ impS ] _ <- node impP
229− , JSStringLiteral _ importPath <- node impS
230− , Just importPath' <- checkImportPath importPath mid mids
231− = pure (Require n importName importPath')
232− toModuleElement n
233− | JSVariables var [ varIntro ] _ <- node n
234− , JSLiteral "var" <- node var
235− , JSVarDecl declN (eq : decl) <- node varIntro
236− , JSIdentifier name <- node declN
237− , JSLiteral "=" <- node eq
238− = pure (Member n False name decl [])
239− toModuleElement n
240− | JSExpression (e : op : decl) <- node n
241− , Just name <- accessor (node e)
242− , JSOperator eq <- node op
243− , JSLiteral "=" <- node eq
244− = pure (Member n True name decl [])
245− where
246− accessor :: Node -> Maybe String
247− accessor (JSMemberDot [ exports ] _ nm)
248− | JSIdentifier "exports" <- node exports
249− , JSIdentifier name <- node nm
250− = Just name
251− accessor (JSMemberSquare [ exports ] _ nm _)
252− | JSIdentifier "exports" <- node exports
253− , JSExpression [e] <- node nm
254− , JSStringLiteral _ name <- node e
255− = Just name
256− accessor _ = Nothing
257− toModuleElement n
258− | JSExpression (mnExp : op : obj: _) <- node n
259− , JSMemberDot [ mn ] _ e <- node mnExp
260− , JSIdentifier "module" <- node mn
261− , JSIdentifier "exports" <- node e
262− , JSOperator eq <- node op
263− , JSLiteral "=" <- node eq
264− , JSObjectLiteral _ props _ <- node obj
265− = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))
266− where
267− toExport :: Node -> m (ExportType, String, JSNode, [Key])
268− toExport (JSPropertyNameandValue name _ [val] ) =
269− (,,val,[]) <$> exportType (node val)
270− <*> extractLabel (node name)
271− toExport _ = err UnsupportedExport
272−
273− exportType :: Node -> m ExportType
274− exportType (JSMemberDot [f] _ _)
275− | JSIdentifier "$foreign" <- node f
276− = pure ForeignReexport
277− exportType (JSMemberSquare [f] _ _ _)
278− | JSIdentifier "$foreign" <- node f
279− = pure ForeignReexport
280− exportType (JSIdentifier s) = pure (RegularExport s)
281− exportType _ = err UnsupportedExport
282−
283− extractLabel :: Node -> m String
284− extractLabel (JSStringLiteral _ nm) = pure nm
285− extractLabel (JSIdentifier nm) = pure nm
286− extractLabel _ = err UnsupportedExport
287−
288− isSeparator :: Node -> Bool
289− isSeparator (JSLiteral ",") = True
290− isSeparator _ = False
291− toModuleElement other = pure (Other other)
292−
293−-- | Eliminate unused code based on the specified entry point set.
294−compile :: [Module] -> [ModuleIdentifier] -> [Module]
295−compile modules [] = modules
296−compile modules entryPoints = filteredModules
297− where
298− (graph, _, vertexFor) = graphFromEdges verts
299−
300− -- | The vertex set
301− verts :: [(ModuleElement, Key, [Key])]
302− verts = do
303− Module mid els <- modules
304− concatMap (toVertices mid) els
305− where
306− -- | Create a set of vertices for a module element.
307− --
308− -- Some special cases worth commenting on:
309− --
310− -- 1) Regular exports which simply export their own name do not count as dependencies.
311− -- Regular exports which rename and reexport an operator do count, however.
312− --
313− -- 2) Require statements don't contribute towards dependencies, since they effectively get
314− -- inlined wherever they are used inside other module elements.
315− toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
316− toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
317− toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
318− where
319− toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
320− toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
321− toVertex _ = Nothing
322− toVertices _ _ = []
323−
324− -- | The set of vertices whose connected components we are interested in keeping.
325− entryPointVertices :: [Vertex]
326− entryPointVertices = catMaybes $ do
327− (_, k@(mid, _), _) <- verts
328− guard $ mid `elem` entryPoints
329− return (vertexFor k)
330−
331− -- | The set of vertices reachable from an entry point
332− reachableSet :: S.Set Vertex
333− reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
334−
335− filteredModules :: [Module]
336− filteredModules = map filterUsed modules
337− where
338− filterUsed :: Module -> Module
339− filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
340− where
341− go :: [ModuleElement] -> [ModuleElement]
342− go [] = []
343− go (d : Other semi : rest)
344− | JSLiteral ";" <- node semi
345− , not (isDeclUsed d)
346− = go rest
347− go (d : rest)
348− | not (isDeclUsed d) = go rest
349− | otherwise = d : go rest
350−
351− -- | Filter out the exports for members which aren't used.
352− filterExports :: ModuleElement -> ModuleElement
353− filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
354− filterExports me = me
355−
356− isDeclUsed :: ModuleElement -> Bool
357− isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
358− isDeclUsed _ = True
359−
360− isKeyUsed :: Key -> Bool
361− isKeyUsed k
362− | Just me <- vertexFor k = me `S.member` reachableSet
363− | otherwise = False
364−
365−-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
366−-- defined in the right order.
367−sortModules :: [Module] -> [Module]
368−sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
369− where
370− (graph, nodeFor, _) = graphFromEdges $ do
371− m@(Module mid els) <- modules
372− return (m, mid, mapMaybe getKey els)
373−
374− getKey :: ModuleElement -> Maybe ModuleIdentifier
375− getKey (Require _ _ mi) = Just mi
376− getKey _ = Nothing
377−
378−-- | A module is empty if it contains no exported members (in other words,
379−-- if the only things left after dead code elimination are module imports and
380−-- "other" foreign code).
381−--
382−-- If a module is empty, we don't want to generate code for it.
383−isModuleEmpty :: Module -> Bool
384−isModuleEmpty (Module _ els) = all isElementEmpty els
385− where
386− isElementEmpty :: ModuleElement -> Bool
387− isElementEmpty (ExportsList exps) = null exps
388− isElementEmpty Require{} = True
389− isElementEmpty (Other _) = True
390− isElementEmpty _ = False
391−
392−-- | Generate code for a set of modules, including a call to main().
393−--
394−-- Modules get defined on the global PS object, as follows:
395−--
396−-- var PS = { };
397−-- (function(exports) {
398−-- ...
399−-- })(PS["Module.Name"] = PS["Module.Name"] || {});
400−--
401−-- In particular, a module and its foreign imports share the same namespace inside PS.
402−-- This saves us from having to generate unique names for a module and its foreign imports,
403−-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
404−-- (so there is no way to have overlaps in code generated by psc).
405−codeGen :: Maybe String -- ^ main module
406− -> String -- ^ namespace
407− -> [Module] -- ^ input modules
408− -> String
409−codeGen optionsMainModule optionsNamespace ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))
410− where
411− moduleToJS :: Module -> [JSNode]
412− moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
413− where
414− declToJS :: ModuleElement -> [JSNode]
415− declToJS (Member n _ _ _ _) = [n]
416− declToJS (Other n) = [n]
417− declToJS (Require _ nm req) =
418− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])
419− [ NN (JSVarDecl (sp (JSIdentifier nm))
420− [ sp (JSLiteral "=")
421− , moduleReference sp (moduleName req)
422− ])
423− ]
424− (nt (JSLiteral ";"))) ]
425− declToJS (ExportsList exps) = map toExport exps
426−
427− where
428− toExport :: (ExportType, String, JSNode, [Key]) -> JSNode
429− toExport (_, nm, val, _) =
430− NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]
431− (nt (JSLiteral "["))
432− (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))
433− (nt (JSLiteral "]")))
434− , NN (JSOperator (sp (JSLiteral "=")))
435− , reindent val
436− , nt (JSLiteral ";")
437− ])
438−
439− reindent :: JSNode -> JSNode
440− reindent (NT n _ _) = sp n
441− reindent nn = nn
442−
443− indent :: [JSNode] -> [JSNode]
444− indent = everywhere (mkT squash)
445− where
446− squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)
447− squash nn = nn
448−
449− splat (CommentA pos s) = CommentA (keepCol pos) s
450− splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
451− splat ann = ann
452−
453− keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)
454−
455− prelude :: [JSNode]
456− prelude =
457− [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)
458− , WhiteSpace tokenPosnEmpty "\n"
459− ])
460− [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))
461− [ sp (JSLiteral "=")
462− , NN (JSObjectLiteral (sp (JSLiteral "{"))
463− []
464− (sp (JSLiteral "}")))
465− ])
466− ]
467− (nt (JSLiteral ";")))
468− , lf
469− ]
470−
471− moduleReference :: (Node -> JSNode) -> String -> JSNode
472− moduleReference f mn =
473− NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]
474− (nt (JSLiteral "["))
475− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
476− (nt (JSLiteral "]")))
477−
478− wrap :: String -> [JSNode] -> [JSNode]
479− wrap mn ds =
480− [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))
481− (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))
482− []
483− (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))
484− (NN (JSBlock [sp (JSLiteral "{")]
485− (lf : ds)
486− [nl (JSLiteral "}")])))]))
487− (nt (JSLiteral ")")))
488− , NN (JSArguments (nt (JSLiteral "("))
489− [ NN (JSExpression [ moduleReference nt mn
490− , NN (JSOperator (sp (JSLiteral "=")))
491− , NN (JSExpressionBinary "||"
492− [ moduleReference sp mn ]
493− (sp (JSLiteral "||"))
494− [ emptyObj ])
495− ])
496− ]
497− (nt (JSLiteral ")")))
498− ])
499− , nt (JSLiteral ";")
500− , lf
501− ]
502− where
503− emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))
504−
505− runMain :: String -> [JSNode]
506− runMain mn =
507− [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]
508− (nt (JSLiteral "["))
509− (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
510− (nt (JSLiteral "]")))
511− ]
512− (nt (JSLiteral "."))
513− (nt (JSIdentifier "main")))
514− , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))
515− ])
516− , nt (JSLiteral ";")
517− ]
518−
519− nt :: Node -> JSNode
520− nt n = NT n tokenPosnEmpty []
521−
522− lf :: JSNode
523− lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
524−
525− sp :: Node -> JSNode
526− sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
527−
528− nl :: Node -> JSNode
529− nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
530−
531−-- | The bundling function.
532−-- This function performs dead code elimination, filters empty modules
533−-- and generates and prints the final Javascript bundle.
534−bundle :: forall m. (Applicative m, MonadError ErrorMessage m)
535− => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
536− -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
537− -> Maybe String -- ^ An optional main module.
538− -> String -- ^ The namespace (e.g. PS).
539− -> m String
540−bundle inputStrs entryPoints mainModule namespace = 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 <- mapM (fmap withDeps . uncurry (toModule 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/Cpp.hsdeleted−528
@@ -1,528 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module generates code in the simplified C++1x intermediate representation from Purescript code
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE GADTs #-}
17−{-# LANGUAGE ViewPatterns #-}
18−{-# LANGUAGE FlexibleContexts #-}
19−{-# LANGUAGE ScopedTypeVariables #-}
20−{-# LANGUAGE PatternGuards #-}
21−
22−module Language.PureScript.CodeGen.Cpp
23− ( module AST
24− , module Common
25− , moduleToCpp
26− , P.prettyPrintCpp
27− ) where
28−
29−import Data.List
30−import Data.Function (on)
31−import qualified Data.Map as M
32−
33−import Control.Monad (forM, replicateM)
34−import Control.Monad.Reader (MonadReader)
35−import Control.Monad.Supply.Class
36−import Language.PureScript.AST.SourcePos
37−import Language.PureScript.CodeGen.Cpp.AST as AST
38−import Language.PureScript.CodeGen.Cpp.Common as Common
39−import Language.PureScript.CodeGen.Cpp.File
40−import Language.PureScript.CodeGen.Cpp.Optimizer
41−import Language.PureScript.CodeGen.Cpp.Optimizer.TCO
42−import Language.PureScript.CodeGen.Cpp.Types
43−import Language.PureScript.CoreFn
44−import Language.PureScript.Names
45−import Language.PureScript.Options
46−import Language.PureScript.Sugar.TypeClasses (superClassDictionaryNames)
47−import Language.PureScript.Traversals (sndM)
48−
49−import qualified Language.PureScript.Constants as C
50−import qualified Language.PureScript.Environment as E
51−import qualified Language.PureScript.Pretty.Cpp as P
52−import qualified Language.PureScript.Types as T
53−
54−-- import Debug.Trace
55−
56−-- |
57−-- Generate code in the simplified C++1x intermediate representation for all declarations in a
58−-- module.
59−--
60−---------------------------------------------------------------------------------------------------
61−moduleToCpp :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m)
62− => E.Environment -> Module Ann -> m [Cpp]
63−---------------------------------------------------------------------------------------------------
64−moduleToCpp env (Module _ mn imps _ foreigns decls) = do
65− cppImports <- traverse (pure . runModuleName) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
66− let cppImports' = "PureScript" : cppImports
67− cppDecls <- concat <$> mapM bindToCpp decls
68− optimized <- traverse optimize cppDecls
69− -- datas <- datasToCpps env mn
70− synonyms <- synonymsToCpp env mn
71− let moduleHeader = fileBegin mn "HH"
72− ++ P.linebreak
73− ++ ((\i -> CppInclude i i) <$> cppImports')
74− ++ (if not (null foreigns)
75− then [CppInclude [] (runModuleName mn ++ "_ffi")]
76− else []
77− )
78− ++ P.linebreak
79− ++ [CppNamespace (runModuleName mn) $
80− (CppUseNamespace <$> cppImports') ++ P.linebreak
81− ++ synonyms
82− ++ toHeader optimized
83− ++ toHeaderFns optimized
84− ]
85− ++ P.linebreak
86− ++ fileEnd mn "HH"
87− let bodyCpps = toBodyDecl optimized ++ toBody optimized
88− moduleBody = CppInclude (runModuleName mn) (runModuleName mn) : P.linebreak
89− ++ (if null bodyCpps
90− then []
91− else [CppNamespace (runModuleName mn) $
92− (CppUseNamespace <$> cppImports') ++ P.linebreak ++ bodyCpps])
93− ++ P.linebreak
94− ++ (if isMain mn then [nativeMain] ++ P.linebreak else [])
95− return $ moduleHeader ++ CppEndOfHeader : moduleBody
96−
97− where
98− -- |
99− -- Generate code in the simplified C++1x intermediate representation for a declaration
100− --
101− -------------------------------------------------------------------------------------------------
102− bindToCpp :: Bind Ann -> m [Cpp]
103− -------------------------------------------------------------------------------------------------
104− bindToCpp (NonRec ident val) = return <$> declToCpp [] ident val
105− bindToCpp (Rec vals) = forM vals (uncurry $ declToCpp [CppRecursive])
106−
107− -- |
108− -- Desugar a declaration into a variable introduction or named function
109− -- declaration.
110− -------------------------------------------------------------------------------------------------
111− declToCpp :: [CppValueQual] -> Ident -> Expr Ann -> m Cpp
112− -------------------------------------------------------------------------------------------------
113− declToCpp _ _ (Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
114− return CppNoOp
115−
116− declToCpp _ ident (Abs _ arg@(Ident "dict")
117− body@(Accessor _ _ (Var _ (Qualified Nothing arg'))))
118− | arg' == arg = do
119− block <- asReturnBlock <$> valueToCpp body
120− let fn' = CppFunction (identToCpp ident)
121− [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]
122− (Just $ CppAny [CppConst, CppRef])
123− []
124− block
125− return fn'
126−
127− declToCpp vqs ident (Abs (_, com, _, _) arg body) = do
128− block <- asReturnBlock <$> valueToCpp body
129− let block' = convertNestedLambdas block
130− fn' = CppFunction (identToCpp ident) [(identToCpp arg, Just $ CppAny [CppConst, CppRef])]
131− (Just $ CppAny [])
132− vqs
133− block'
134− return (CppComment com fn')
135−
136− declToCpp _ ident (Constructor _ _ (ProperName _) fields) = return $
137− CppFunction (identToCpp ident) (farg <$> f)
138− (Just $ CppAny [])
139− []
140− (CppBlock (fieldLambdas fs))
141− where
142− name = qualifiedToStr (ModuleName []) id (Qualified (Just mn) ident)
143− fields' = identToCpp <$> fields
144− (f, fs) | (f' : fs') <- fields' = ([f'], fs')
145− | otherwise = ([], [])
146− farg = \x -> (x, Just $ CppAny [CppConst, CppRef])
147− fieldLambdas flds
148− | (f' : fs') <- flds = [CppReturn $ CppLambda [CppCaptureAll] (farg <$> [f'])
149− (Just $ CppAny [])
150− (CppBlock $ fieldLambdas fs')]
151− | otherwise = [CppReturn (CppObjectLiteral ((ctorKey, CppStringLiteralHash name) : zip fields' (CppVar <$> fields')))]
152−
153− declToCpp _ ident val = do
154− val' <- valueToCpp val
155− return $ CppVariableIntroduction (identToCpp ident, Just $ CppAny [CppConst]) [] (Just val')
156−
157− -------------------------------------------------------------------------------------------------
158− toLambda :: [CppCaptureType] -> Cpp -> Cpp
159− -------------------------------------------------------------------------------------------------
160− toLambda cs (CppFunction name args _ qs body) =
161− CppVariableIntroduction (name, Just $ CppAny [CppConst])
162− (filter (==CppStatic) qs)
163− (Just (CppLambda cs' args (Just $ CppAny []) body))
164− where
165− cs' | (not . null) (qs `intersect` [CppInline, CppStatic]) = []
166− | otherwise = cs
167− toLambda cs (CppComment com cpp) = CppComment com (toLambda cs cpp)
168− toLambda _ _ = error "Not a function!"
169−
170− -------------------------------------------------------------------------------------------------
171− asReturnBlock :: Cpp -> Cpp
172− -------------------------------------------------------------------------------------------------
173− asReturnBlock cpp = CppBlock [CppReturn cpp]
174−
175− -------------------------------------------------------------------------------------------------
176− convertNestedLambdas :: Cpp -> Cpp
177− -------------------------------------------------------------------------------------------------
178− convertNestedLambdas = everywhereOnCpp go
179− where
180− go :: Cpp -> Cpp
181− go f@(CppFunction {}) = toLambda [CppCaptureAll] f
182− go (CppLambda [] args rtyp body) = CppLambda [CppCaptureAll] args rtyp body
183− go cpp = cpp
184−
185− -------------------------------------------------------------------------------------------------
186− convertRecursiveFns :: [Cpp] -> [Cpp]
187− -------------------------------------------------------------------------------------------------
188− convertRecursiveFns cpps
189− | not $ null fns = dict : (accessor topdict <$> fns) ++ (everywhereOnCpp removeRec <$> cpps)
190− where
191− fns :: [(String, Cpp)]
192− fns = toelem <$> concatMap (everythingOnCpp (++) recursive) cpps
193−
194− recursive :: Cpp -> [Cpp]
195− recursive cpp'@(CppFunction _ _ _ qs _) | CppRecursive `elem` qs = [cpp']
196− recursive _ = []
197−
198− removeRec :: Cpp -> Cpp
199− removeRec(CppFunction _ _ _ qs _) | CppRecursive `elem` qs = CppNoOp
200− removeRec cpp' = cpp'
201−
202− dict :: Cpp
203− dict = CppVariableIntroduction (topdict, Just $ CppAny [CppConst]) []
204− (Just $ CppObjectLiteral fns)
205−
206− accessor :: String -> (String, Cpp) -> Cpp
207− accessor dictname (name, _) = CppVariableIntroduction (name, Just $ CppAny [CppConst]) [] (Just accessed)
208− where
209− dict' = CppVar dictname
210− accessed = CppApp (CppIndexer (CppStringLiteral name) dict') [dict']
211−
212− toelem :: Cpp -> (String, Cpp)
213− toelem (CppFunction name args rtyp _ (CppBlock body)) =
214− (name, withdict $ CppLambda [CppCaptureAll] args rtyp (CppBlock $ (accessor localdict <$> fns) ++ body))
215− toelem _ = error "not a function"
216−
217− withdict :: Cpp -> Cpp
218− withdict cpp' =
219− CppLambda [CppCaptureAll] [(localdict, Just $ CppAny [CppConst, CppRef])]
220− (Just $ CppAny [])
221− (CppBlock [CppReturn cpp'])
222− topdict :: String
223− topdict = "__dict__"
224− localdict :: String
225− localdict = "_dict_"
226−
227− convertRecursiveFns cpps = cpps
228−
229− -- |
230− -- Generate code in the simplified C++1x intermediate representation for a value or expression.
231− --
232− -------------------------------------------------------------------------------------------------
233− valueToCpp :: Expr Ann -> m Cpp
234− -------------------------------------------------------------------------------------------------
235− valueToCpp (Var (_, _, _, Just (IsConstructor _ [])) ident) =
236− return $ CppApp (CppVar $ qualifiedToStr' id ident) []
237−
238− valueToCpp (Var (_, _, _, Just (IsConstructor _ _)) ident) =
239− return . CppVar $ qualifiedToStr' id ident
240−
241− valueToCpp (Var _ ident) =
242− return $ varToCpp ident
243−
244− valueToCpp (Literal _ (NumericLiteral n)) =
245− return (CppNumericLiteral n)
246−
247− valueToCpp (Literal _ (StringLiteral s)) =
248− return (CppStringLiteral s)
249−
250− valueToCpp (Literal _ (CharLiteral c)) =
251− return (CppCharLiteral c)
252−
253− valueToCpp (Literal _ (BooleanLiteral b)) =
254− return (CppBooleanLiteral b)
255−
256− valueToCpp (Literal _ (ArrayLiteral xs)) =
257− CppArrayLiteral <$> mapM valueToCpp xs
258−
259− valueToCpp (Literal _ (ObjectLiteral ps)) =
260− CppObjectLiteral <$> sortBy (compare `on` fst) <$> mapM (sndM valueToCpp) ps
261−
262− valueToCpp (Accessor _ prop val) =
263− CppIndexer <$> pure (CppStringLiteral prop) <*> valueToCpp val
264−
265− -- TODO: use a more efficient way of copying/updating the map?
266− valueToCpp (ObjectUpdate (_, _, Just ty, _) obj ps) = do
267− obj' <- valueToCpp obj
268− updatedFields <- mapM (sndM valueToCpp) ps
269− let origKeys = (allKeys ty) \\ (fst <$> updatedFields)
270− origFields = (\key -> (key, CppIndexer (CppStringLiteral key) obj')) <$> origKeys
271− return $ CppObjectLiteral . sortBy (compare `on` fst) $ origFields ++ updatedFields
272− where
273− allKeys :: T.Type -> [String]
274− allKeys (T.TypeApp (T.TypeConstructor _) r@(T.RCons {})) = fst <$> (fst $ T.rowToList r)
275− allKeys (T.ForAll _ t _) = allKeys t
276− allKeys _ = error $ show "Not a recognized row type"
277−
278− valueToCpp (ObjectUpdate _ _ _) = error $ "Bad Type in object update!"
279−
280− valueToCpp (Abs _ arg body) = do
281− cpp <- valueToCpp body
282− let cpp' = convertNestedLambdas cpp
283− return $ CppLambda [] [(identToCpp arg, Just $ CppAny [CppConst, CppRef])] (Just $ CppAny []) (asReturnBlock cpp')
284−
285− -- valueToCpp (App _ e (Var _ (Qualified (Just (ModuleName [ProperName "Prim"])) (Ident "undefined")))) =
286− -- valueToCpp e
287−
288− valueToCpp e@App{} = do
289− let (f, args) = unApp e []
290− args' <- mapM valueToCpp args
291− case f of
292− Var (_, _, _, Just IsNewtype) _ -> return (head args')
293− Var (_, _, _, Just IsTypeClassConstructor) (Qualified mn' (Ident classname)) ->
294− let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in
295− return . CppObjectLiteral $ zip ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns)) args'
296− _ -> -- TODO: verify this
297− flip (foldl (\fn a -> CppApp fn [a])) args' <$> valueToCpp f
298−
299− valueToCpp (Case (maybeSpan, _, ty, _) values binders) = do
300− vals <- mapM valueToCpp values
301− bindersToCpp maybeSpan ty binders vals
302−
303− valueToCpp (Let _ ds val) = do
304− ds' <- concat <$> mapM bindToCpp ds
305− ret <- valueToCpp val
306− let ds'' = tco defaultOptions <$> ds'
307− let rs = if hasRecursion ds''
308− then convertRecursiveFns ds''
309− else ds''
310− let cpps = convertNestedLambdas <$> rs
311− return $ CppApp (CppLambda [] [] Nothing (CppBlock (cpps ++ [CppReturn ret]))) []
312− where
313− hasRecursion :: [Cpp] -> Bool
314− hasRecursion cpps' = any (everythingOnCpp (||) hasRecursiveRef) cpps'
315− where
316− fnames :: [String]
317− fnames = concatMap (everythingOnCpp (++) fname) cpps'
318−
319− fname :: Cpp -> [String]
320− fname (CppFunction name _ _ _ _) = [name]
321− fname _ = []
322−
323− hasRecursiveRef :: Cpp -> Bool
324− hasRecursiveRef (CppFunction _ _ _ _ body) = everythingOnCpp (||) ref body
325− hasRecursiveRef _ = False
326−
327− ref :: Cpp -> Bool
328− ref (CppVar name) | name `elem` fnames = True
329− ref _ = False
330−
331− valueToCpp Constructor{} = return CppNoOp
332−
333− -- |
334− -- Generate code in the simplified C++1x intermediate representation for a reference to a
335− -- variable.
336− --
337− -------------------------------------------------------------------------------------------------
338− varToCpp :: Qualified Ident -> Cpp
339− -------------------------------------------------------------------------------------------------
340− varToCpp (Qualified Nothing ident) = CppVar (identToCpp ident)
341− varToCpp qual = qualifiedToCpp id qual
342−
343− -- |
344− -- Generate code in the simplified C++1x intermediate representation for pattern match binders
345− -- and guards.
346− --
347− -------------------------------------------------------------------------------------------------
348− bindersToCpp :: Maybe SourceSpan -> Maybe T.Type -> [CaseAlternative Ann] -> [Cpp] -> m Cpp
349− -------------------------------------------------------------------------------------------------
350− bindersToCpp maybeSpan _ binders vals = do
351− valNames <- replicateM (length vals) freshName
352− let assignments = zipWith mkVarDecl valNames (map Just vals)
353− cpps <- forM binders $ \(CaseAlternative bs result) -> do
354− ret <- guardsToCpp result
355− go valNames ret bs
356− return $ CppApp (CppLambda []
357− []
358− (Just $ CppAny [])
359− (CppBlock (assignments ++ concat cpps ++ [failedPatternError valNames]))) []
360− where
361− mkVarDecl :: String -> Maybe Cpp -> Cpp
362− mkVarDecl name = CppVariableIntroduction (name, Nothing) []
363− go :: [String] -> [Cpp] -> [Binder Ann] -> m [Cpp]
364− go _ done [] = return done
365− go (v:vs) done' (b:bs) = do
366− done'' <- go vs done' bs
367− binderToCpp v done'' b
368− go _ _ _ = error "Invalid arguments to bindersToCpp"
369−
370− failedPatternError :: [String] -> Cpp
371− failedPatternError _ =
372− CppThrow $ CppApp (CppVar "runtime_error") [CppStringLiteral errorMessage]
373−
374− errorMessage :: String
375− errorMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "
376−
377− guardsToCpp :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [Cpp]
378− guardsToCpp (Left gs) = forM gs $ \(cond, val) -> do
379− cond' <- valueToCpp cond
380− done <- valueToCpp val
381− return $ CppIfElse cond' (asReturnBlock done) Nothing
382− guardsToCpp (Right v) = return . CppReturn <$> valueToCpp v
383−
384− -- |
385− -- Generate code in the simplified C++1x intermediate representation for a pattern match
386− -- binder.
387− --
388− -------------------------------------------------------------------------------------------------
389− binderToCpp :: String -> [Cpp] -> Binder Ann -> m [Cpp]
390− -------------------------------------------------------------------------------------------------
391− binderToCpp _ done (NullBinder{}) = return done
392−
393− binderToCpp varName done (LiteralBinder _ l) =
394− literalToBinderCpp varName done l
395−
396− binderToCpp varName done (VarBinder _ ident) =
397− return (CppVariableIntroduction (identToCpp ident, Just $ CppAny [CppConst]) [] (Just (CppVar varName)) : done)
398−
399− binderToCpp varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
400− binderToCpp varName done b
401−
402− binderToCpp varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do
403− cpps <- go (zip fields bs) done
404− let ctor' = qualifiedToStr (ModuleName []) (Ident . runProperName) ctor
405− return $ case ctorType of
406− ProductType -> cpps
407− SumType ->
408− [ CppIfElse (CppBinary Equal (CppIndexer (CppStringLiteral ctorKey) (CppVar varName))
409− (CppStringLiteralHash ctor'))
410− (CppBlock cpps)
411− Nothing ]
412− where
413− go :: [(Ident, Binder Ann)] -> [Cpp] -> m [Cpp]
414− go [] done' = return done'
415− go ((field, binder) : remain) done' = do
416− argVar <- freshName
417− done'' <- go remain done'
418− cpps <- binderToCpp argVar done'' binder
419− return (CppVariableIntroduction (argVar, Nothing)
420− []
421− (Just (CppIndexer (CppStringLiteral $ identToCpp field) (CppVar varName)))
422− : cpps)
423−
424− binderToCpp _ _ b@(ConstructorBinder{}) =
425− error $ "Invalid ConstructorBinder in binderToCpp: " ++ show b
426−
427− binderToCpp varName done (NamedBinder _ ident binder) = do
428− cpp <- binderToCpp varName done binder
429− return (CppVariableIntroduction (identToCpp ident, Just $ CppAny [CppConst]) [] (Just (CppVar varName)) : cpp)
430−
431− -------------------------------------------------------------------------------------------------
432− literalToBinderCpp :: String -> [Cpp] -> Literal (Binder Ann) -> m [Cpp]
433− -------------------------------------------------------------------------------------------------
434− literalToBinderCpp varName done (NumericLiteral num) =
435− return [CppIfElse (CppBinary Equal (CppVar varName) (CppNumericLiteral num)) (CppBlock done) Nothing]
436−
437− literalToBinderCpp varName done (CharLiteral c) =
438− return [CppIfElse (CppBinary Equal (CppCast charType $ CppVar varName)
439− (CppCharLiteral c))
440− (CppBlock done)
441− Nothing]
442−
443− literalToBinderCpp varName done (StringLiteral str) =
444− return [CppIfElse (CppBinary Equal (CppCast stringType $ CppVar varName)
445− (CppStringLiteral str))
446− (CppBlock done)
447− Nothing]
448−
449− literalToBinderCpp varName done (BooleanLiteral True) =
450− return [CppIfElse (CppVar varName) (CppBlock done) Nothing]
451−
452− literalToBinderCpp varName done (BooleanLiteral False) =
453− return [CppIfElse (CppUnary CppNot (CppVar varName)) (CppBlock done) Nothing]
454−
455− literalToBinderCpp varName done (ObjectLiteral bs) = go done bs
456− where
457− go :: [Cpp] -> [(String, Binder Ann)] -> m [Cpp]
458− go done' [] = return done'
459− go done' ((prop, binder):bs') = do
460− propVar <- freshName
461− done'' <- go done' bs'
462− cpp <- binderToCpp propVar done'' binder
463− return (CppVariableIntroduction (propVar, Nothing)
464− []
465− (Just (CppIndexer (CppStringLiteral prop) (CppVar varName)))
466− : cpp)
467−
468− literalToBinderCpp varName done (ArrayLiteral bs) = do
469− cpp <- go done 0 bs
470− let cond = case length bs of
471− 0 -> CppBinary Dot (CppCast arrayType $ CppVar varName)
472− (CppApp (CppVar "empty") [])
473− n -> let var = CppCast arrayType $ CppVar varName in
474− CppBinary Equal (CppBinary Dot var (CppApp (CppVar "size") []))
475− (CppNumericLiteral (Left (fromIntegral n)))
476− return [ CppIfElse cond (CppBlock cpp) Nothing ]
477− where
478− go :: [Cpp] -> Integer -> [Binder Ann] -> m [Cpp]
479− go done' _ [] = return done'
480− go done' index (binder:bs') = do
481− elVar <- freshName
482− done'' <- go done' (index + 1) bs'
483− cpp <- binderToCpp elVar done'' binder
484− return (CppVariableIntroduction (elVar, Nothing) []
485− (Just (CppIndexer (CppNumericLiteral (Left index)) (CppVar varName))) : cpp)
486−
487− -------------------------------------------------------------------------------------------------
488−
489− unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
490− unApp (App _ val arg) args = unApp val (arg : args)
491− unApp other args = (other, args)
492−
493− qualifiedToCpp :: (a -> Ident) -> Qualified a -> Cpp
494− qualifiedToCpp f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = CppVar . runIdent $ f a
495− qualifiedToCpp f (Qualified (Just mn') a)
496− | mn /= mn' = CppAccessor (CppVar . identToCpp $ f a) (CppVar (moduleNameToCpp mn'))
497− qualifiedToCpp f (Qualified _ a) = CppVar $ identToCpp (f a)
498−
499− qualifiedToStr' :: (a -> Ident) -> Qualified a -> String
500− qualifiedToStr' = qualifiedToStr mn
501−
502− -- |
503− -- Find a class in scope by name, retrieving its list of constraints, function names and types.
504− --
505− findClass :: Qualified ProperName -> Maybe ([String], [T.Constraint], [(String, T.Type)])
506− findClass name
507− | Just (params, fns, constraints) <- M.lookup name (E.typeClasses env),
508− fns' <- (\(i,t) -> (runIdent i, t)) <$> fns
509− = Just (fst <$> params, constraints, (sortBy (compare `on` normalizedName . fst) fns'))
510− findClass _ = Nothing
511−
512−-------------------------------------------------------------------------------------------------
513−synonymsToCpp :: Monad m => E.Environment -> ModuleName -> m [Cpp]
514−-------------------------------------------------------------------------------------------------
515−synonymsToCpp env mn
516− | tcs <- E.typeClasses env,
517− ds@(_:_) <- M.toList
518− . M.filterWithKey (\k@(Qualified mn' _) _ -> mn' == Just mn && M.lookup k tcs == Nothing)
519− $ E.typeSynonyms env = do
520− let names' = qualifiedToStr mn (Ident . runProperName) . fst <$> ds
521− typs = replicate (length ds) (CppAny [])
522− syns = zip names' typs
523− cpps = toTypeAlias <$> syns
524− return $ cpps
525− | otherwise = return []
526− where
527− toTypeAlias :: (String, CppType) -> Cpp
528− toTypeAlias (n, t) = CppTypeAlias (n, []) t []
src/Language/PureScript/CodeGen/Cpp/AST.hsdeleted−352
@@ -1,352 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.AST
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Data types for the intermediate simplified-C++11 AST
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DeriveDataTypeable #-}
17−{-# LANGUAGE CPP #-}
18−
19−module Language.PureScript.CodeGen.Cpp.AST where
20−
21−#if __GLASGOW_HASKELL__ < 710
22−import Control.Applicative (Applicative, (<$>), (<*>))
23−import Data.Traversable (traverse)
24−#endif
25−import Control.Monad.Identity
26−import Data.Data
27−import Language.PureScript.Comments
28−import Language.PureScript.CodeGen.Cpp.Types
29−import Language.PureScript.Traversals
30−
31−-- |
32−-- Built-in unary operators
33−--
34−data CppUnaryOp
35− -- |
36− -- Numeric negation
37− --
38− = CppNegate
39− -- |
40− -- Boolean negation
41− --
42− | CppNot
43− -- |
44− -- Bitwise negation
45− --
46− | CppBitwiseNot
47− -- |
48− -- Numeric unary \'plus\'
49− --
50− | CppPositive
51− -- |
52− -- Constructor
53− --
54− | CppNew deriving (Show, Eq, Data, Typeable)
55−
56−-- |
57−-- Built-in binary operators
58−--
59−data BinaryOp
60− -- |
61− -- Numeric addition
62− --
63− = Add
64− -- |
65− -- Numeric subtraction
66− --
67− | Subtract
68− -- |
69− -- Numeric multiplication
70− --
71− | Multiply
72− -- |
73− -- Numeric division
74− --
75− | Divide
76− -- |
77− -- Remainder
78− --
79− | Modulus
80− -- |
81− -- TODO: revisit this
82− --
83− | Dot
84− -- |
85− -- Generic equality test
86− --
87− | Equal
88− -- |
89− -- Generic inequality test
90− --
91− | NotEqual
92− -- |
93− -- Numeric less-than
94− --
95− | LessThan
96− -- |
97− -- Numeric less-than-or-equal
98− --
99− | LessThanOrEqual
100− -- |
101− -- Numeric greater-than
102− --
103− | GreaterThan
104− -- |
105− -- Numeric greater-than-or-equal
106− --
107− | GreaterThanOrEqual
108− -- |
109− -- Boolean and
110− --
111− | And
112− -- |
113− -- Boolean or
114− --
115− | Or
116− -- |
117− -- Bitwise and
118− --
119− | BitwiseAnd
120− -- |
121− -- Bitwise or
122− --
123− | BitwiseOr
124− -- |
125− -- Bitwise xor
126− --
127− | BitwiseXor
128− -- |
129− -- Bitwise left shift
130− --
131− | ShiftLeft
132− -- |
133− -- Bitwise right shift
134− --
135− | ShiftRight
136− --
137− deriving (Show, Eq, Data, Typeable)
138−
139−-- |
140−-- Data type for simplified C++11 expressions
141−--
142−data Cpp
143− -- |
144− -- A numeric literal
145− --
146− = CppNumericLiteral (Either Integer Double)
147− -- |
148− -- A string literal
149− --
150− | CppStringLiteral String
151− -- |
152− -- A character literal
153− --
154− | CppCharLiteral Char
155− -- |
156− -- A boolean literal
157− --
158− | CppBooleanLiteral Bool
159− -- |
160− -- A unary operator application
161− --
162− | CppUnary CppUnaryOp Cpp
163− -- |
164− -- A binary operator application
165− --
166− | CppBinary BinaryOp Cpp Cpp
167− -- |
168− -- An array literal
169− --
170− | CppArrayLiteral [Cpp]
171− -- |
172− -- An array indexer expression
173− --
174− | CppIndexer Cpp Cpp
175− -- |
176− -- An object literal
177− --
178− | CppObjectLiteral [(String, Cpp)]
179− -- |
180− -- An general property accessor expression (optional type, property, expr)
181− --
182− | CppAccessor Cpp Cpp
183− -- |
184− -- A function introduction (name, arguments, return type, qualifiers, body)
185− --
186− | CppFunction String [(String, Maybe CppType)] (Maybe CppType) [CppValueQual] Cpp
187− -- |
188− -- A lambda introduction (arguments, return type, body)
189− --
190− | CppLambda [CppCaptureType] [(String, Maybe CppType)] (Maybe CppType) Cpp
191− -- |
192− -- Value type cast
193− --
194− | CppCast CppType Cpp
195− -- |
196− -- Function application
197− --
198− | CppApp Cpp [Cpp]
199− -- |
200− -- Variable
201− --
202− | CppVar String
203− -- |
204− -- A block of expressions in braces
205− --
206− | CppBlock [Cpp]
207− -- |
208− -- A C++ namespace
209− --
210− | CppNamespace String [Cpp]
211− -- |
212− -- A C++ #include
213− --
214− | CppInclude String String
215− -- |
216− -- A C++ using namespace declaration
217− --
218− | CppUseNamespace String
219− -- |
220− -- Type alias, e.g. "using T = U" (new name and template types, original type)
221− --
222− | CppTypeAlias (String,[(String, Int)]) CppType String
223− -- |
224− -- A variable introduction and optional initialization
225− --
226− | CppVariableIntroduction (String, Maybe CppType) [CppValueQual] (Maybe Cpp)
227− -- |
228− -- A variable assignment
229− --
230− | CppAssignment Cpp Cpp
231− -- |
232− -- While loop
233− --
234− | CppWhile Cpp Cpp
235− -- |
236− -- If-then-else statement
237− --
238− | CppIfElse Cpp Cpp (Maybe Cpp)
239− -- |
240− -- Return statement
241− --
242− | CppReturn Cpp
243− -- |
244− -- Throw statement
245− --
246− | CppThrow Cpp
247− -- |
248− -- Continue statement
249− --
250− | CppContinue
251− -- |
252− -- A string literal compile-time hash
253− --
254− | CppStringLiteralHash String
255− -- |
256− -- Empty statement/expression
257− --
258− | CppNoOp
259− -- |
260− -- Marker for header/source split
261− --
262− | CppEndOfHeader
263− -- |
264− -- Raw C++11 (generated when parsing fails for an inline foreign import declaration)
265− --
266− | CppRaw String
267− -- |
268− -- Commented C++11
269− --
270− | CppComment [Comment] Cpp deriving (Show, Eq, Data, Typeable)
271−
272−--
273−-- Traversals
274−--
275−
276−everywhereOnCpp :: (Cpp -> Cpp) -> Cpp -> Cpp
277−everywhereOnCpp f = go
278− where
279− go :: Cpp -> Cpp
280− go (CppUnary op j) = f (CppUnary op (go j))
281− go (CppBinary op j1 j2) = f (CppBinary op (go j1) (go j2))
282− go (CppArrayLiteral cpp) = f (CppArrayLiteral (map go cpp))
283− go (CppIndexer j1 j2) = f (CppIndexer (go j1) (go j2))
284− go (CppObjectLiteral cpp) = f (CppObjectLiteral (map (fmap go) cpp))
285− go (CppAccessor prop j) = f (CppAccessor (go prop) (go j))
286− go (CppFunction name args rty qs j) = f (CppFunction name args rty qs (go j))
287− go (CppLambda cps args rty j) = f (CppLambda cps args rty (go j))
288− go (CppCast t cpp) = f (CppCast t (go cpp))
289− go (CppApp j cpp) = f (CppApp (go j) (map go cpp))
290− go (CppBlock cpp) = f (CppBlock (map go cpp))
291− go (CppNamespace name cpp) = f (CppNamespace name (map go cpp))
292− go (CppVariableIntroduction name qs j) = f (CppVariableIntroduction name qs (fmap go j))
293− go (CppAssignment j1 j2) = f (CppAssignment (go j1) (go j2))
294− go (CppWhile j1 j2) = f (CppWhile (go j1) (go j2))
295− go (CppIfElse j1 j2 j3) = f (CppIfElse (go j1) (go j2) (fmap go j3))
296− go (CppReturn cpp) = f (CppReturn (go cpp))
297− go (CppThrow cpp) = f (CppThrow (go cpp))
298− go (CppComment com j) = f (CppComment com (go j))
299− go other = f other
300−
301−everywhereOnCppTopDown :: (Cpp -> Cpp) -> Cpp -> Cpp
302−everywhereOnCppTopDown f = runIdentity . everywhereOnCppTopDownM (Identity . f)
303−
304−everywhereOnCppTopDownM :: (Applicative m, Monad m) => (Cpp -> m Cpp) -> Cpp -> m Cpp
305−everywhereOnCppTopDownM f = f >=> go
306− where
307− f' = f >=> go
308− go (CppUnary op j) = CppUnary op <$> f' j
309− go (CppBinary op j1 j2) = CppBinary op <$> f' j1 <*> f' j2
310− go (CppArrayLiteral cpp) = CppArrayLiteral <$> traverse f' cpp
311− go (CppIndexer j1 j2) = CppIndexer <$> f' j1 <*> f' j2
312− go (CppObjectLiteral cpp) = CppObjectLiteral <$> traverse (sndM f') cpp
313− go (CppAccessor prop j) = CppAccessor prop <$> f' j
314− go (CppFunction name args rty qs j) = CppFunction name args rty qs <$> f' j
315− go (CppLambda cps args rty j) = CppLambda cps args rty <$> f' j
316− go (CppCast t cpp) = CppCast t <$> f' cpp
317− go (CppApp j cpp) = CppApp <$> f' j <*> traverse f' cpp
318− go (CppBlock cpp) = CppBlock <$> traverse f' cpp
319− go (CppNamespace name cpp) = CppNamespace name <$> traverse f' cpp
320− go (CppVariableIntroduction name qs j) = CppVariableIntroduction name qs <$> traverse f' j
321− go (CppAssignment j1 j2) = CppAssignment <$> f' j1 <*> f' j2
322− go (CppWhile j1 j2) = CppWhile <$> f' j1 <*> f' j2
323− go (CppIfElse j1 j2 j3) = CppIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
324− go (CppReturn j) = CppReturn <$> f' j
325− go (CppThrow j) = CppThrow <$> f' j
326− go (CppComment com j) = CppComment com <$> f' j
327− go other = f other
328−
329−everythingOnCpp :: (r -> r -> r) -> (Cpp -> r) -> Cpp -> r
330−everythingOnCpp (<>) f = go
331− where
332− go j@(CppUnary _ j1) = f j <> go j1
333− go j@(CppBinary _ j1 j2) = f j <> go j1 <> go j2
334− go j@(CppArrayLiteral cpp) = foldl (<>) (f j) (map go cpp)
335− go j@(CppIndexer j1 j2) = f j <> go j1 <> go j2
336− go j@(CppObjectLiteral cpp) = foldl (<>) (f j) (map (go . snd) cpp)
337− go j@(CppAccessor j1 j2) = f j <> go j1 <> go j2
338− go j@(CppFunction _ _ _ _ j1) = f j <> go j1
339− go j@(CppLambda _ _ _ j1) = f j <> go j1
340− go j@(CppCast _ cpp) = f j <> go cpp
341− go j@(CppApp j1 cpp) = foldl (<>) (f j <> go j1) (map go cpp)
342− go j@(CppBlock cpp) = foldl (<>) (f j) (map go cpp)
343− go j@(CppNamespace _ cpp) = foldl (<>) (f j) (map go cpp)
344− go j@(CppVariableIntroduction _ _ (Just j1)) = f j <> go j1
345− go j@(CppAssignment j1 j2) = f j <> go j1 <> go j2
346− go j@(CppWhile j1 j2) = f j <> go j1 <> go j2
347− go j@(CppIfElse j1 j2 Nothing) = f j <> go j1 <> go j2
348− go j@(CppIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3
349− go j@(CppReturn j1) = f j <> go j1
350− go j@(CppThrow j1) = f j <> go j1
351− go j@(CppComment _ j1) = f j <> go j1
352− go other = f other
src/Language/PureScript/CodeGen/Cpp/Common.hsdeleted−205
@@ -1,205 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Common
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Common code generation utility functions
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE PatternGuards #-}
17−
18−module Language.PureScript.CodeGen.Cpp.Common where
19−
20−import Data.Char
21−import Data.List (intercalate)
22−
23−import Language.PureScript.Names
24−
25−-- |
26−-- Convert an Ident into a valid C++11 identifier:
27−--
28−-- * Alphanumeric characters are kept unmodified.
29−--
30−-- * Reserved C++11 identifiers are wrapped with '_'
31−--
32−-- * Symbols are wrapped with '_' between a symbol name or their ordinal value.
33−--
34−identToCpp :: Ident -> String
35−identToCpp (Ident name) | nameIsCppReserved name = '_' : name ++ "_"
36−identToCpp (Ident name) = concatMap identCharToString name
37−identToCpp (Op op) = concatMap identCharToString op
38−
39−-- |
40−-- Test if a string is a valid Cpp identifier without escaping.
41−--
42−identNeedsEscaping :: String -> Bool
43−identNeedsEscaping s = s /= identToCpp (Ident s)
44−
45−-- |
46−-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
47−-- ordinal value.
48−--
49−identCharToString :: Char -> String
50−identCharToString c | isAlphaNum c = [c]
51−identCharToString '_' = "_"
52−identCharToString '.' = "_dot_"
53−identCharToString '$' = "_dollar_"
54−identCharToString '~' = "_tilde_"
55−identCharToString '=' = "_eq_"
56−identCharToString '<' = "_less_"
57−identCharToString '>' = "_greater_"
58−identCharToString '!' = "_bang_"
59−identCharToString '#' = "_hash_"
60−identCharToString '%' = "_percent_"
61−identCharToString '^' = "_up_"
62−identCharToString '&' = "_amp_"
63−identCharToString '|' = "_bar_"
64−identCharToString '*' = "_times_"
65−identCharToString '/' = "_div_"
66−identCharToString '+' = "_plus_"
67−identCharToString '-' = "_minus_"
68−identCharToString ':' = "_colon_"
69−identCharToString '\\' = "_bslash_"
70−identCharToString '?' = "_qmark_"
71−identCharToString '@' = "_at_"
72−identCharToString '\'' = "_prime_"
73−identCharToString c = '_' : show (ord c) ++ "_"
74−
75−-- |
76−-- Checks whether an identifier name is reserved in C++11.
77−--
78−nameIsCppReserved :: String -> Bool
79−nameIsCppReserved name =
80− name `elem` [ "alignas"
81− , "alignof"
82− , "and"
83− , "and_eq"
84− , "any"
85− , "asm"
86− , "assert"
87− , "auto"
88− , "bitand"
89− , "bitor"
90− , "bool"
91− , "boost"
92− , "break"
93− , "case"
94− , "cast"
95− , "catch"
96− , "char"
97− , "char16_t"
98− , "char32_t"
99− , "class"
100− , "compl"
101− , "concept"
102− , "const"
103− , "constexpr"
104− , "const_cast"
105− , "continue"
106− , "decltype"
107− , "default"
108− , "delete"
109− , "djb2"
110− , "do"
111− , "double"
112− , "dynamic_cast"
113− , "else"
114− , "enum"
115− , "explicit"
116− , "export"
117− , "extern"
118− , "false"
119− , "final"
120− , "float"
121− , "for"
122− , "friend"
123− , "goto"
124− , "HASH"
125− , "if"
126− , "import"
127− , "inline"
128− , "int"
129− , "KEY"
130− , "list"
131− , "long"
132− , "map_key_t"
133− , "mutable"
134− , "namespace"
135− , "new"
136− , "nil"
137− , "noexcept"
138− , "not"
139− , "not_eq"
140− , "NULL"
141− , "null"
142− , "nullptr"
143− , "nullptr_t"
144− , "operator"
145− , "or"
146− , "or_eq"
147− , "override"
148− , "param"
149− , "private"
150− , "protected"
151− , "public"
152− , "PureScript"
153− , "register"
154− , "reinterpret_cast"
155− , "requires"
156− , "return"
157− , "runtime_error"
158− , "shared_list"
159− , "short"
160− , "signed"
161− , "sizeof"
162− , "static"
163− , "static_assert"
164− , "static_cast"
165− , "std"
166− , "string"
167− , "struct"
168− , "switch"
169− , "template"
170− , "this"
171− , "thread_local"
172− , "throw"
173− , "true"
174− , "try"
175− , "typedef"
176− , "typeid"
177− , "typename"
178− , "typeof"
179− , "union"
180− , "unsigned"
181− , "using"
182− , "virtual"
183− , "void"
184− , "volatile"
185− , "wchar_t"
186− , "while"
187− , "xor"
188− , "xor_eq" ] || properNameIsCppReserved name
189−
190−normalizedName :: String -> String
191−normalizedName ('_' : s) | last s == '_', s' <- init s, nameIsCppReserved s' = s'
192−normalizedName s = s
193−
194−moduleNameToCpp :: ModuleName -> String
195−moduleNameToCpp (ModuleName pns) =
196− let name = intercalate "_" (runProperName `map` pns)
197− in if properNameIsCppReserved name then '_' : name ++ "_" else name
198−
199−-- |
200−-- Checks whether a proper name is reserved in C++11.
201−--
202−properNameIsCppReserved :: String -> Bool
203−properNameIsCppReserved name =
204− name `elem` [ "Private"
205− , "PureScript" ]
src/Language/PureScript/CodeGen/Cpp/File.hsdeleted−158
@@ -1,158 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.File
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- File generation utility functions
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE PatternGuards #-}
17−
18−module Language.PureScript.CodeGen.Cpp.File where
19−
20−import Data.Maybe
21−
22−import Language.PureScript.CodeGen.Cpp.AST
23−-- import Language.PureScript.CodeGen.Cpp.Templates
24−import Language.PureScript.CodeGen.Cpp.Types
25−import Language.PureScript.Names
26−
27−import qualified Language.PureScript.Pretty.Cpp as P
28−import qualified Language.PureScript.Pretty.Common as P
29−
30−---------------------------------------------------------------------------------------------------
31−toHeader :: [Cpp] -> [Cpp]
32−---------------------------------------------------------------------------------------------------
33−toHeader = catMaybes . map go
34− where
35− go :: Cpp -> Maybe Cpp
36− go (CppNamespace name cpps) = Just (CppNamespace name (toHeader cpps))
37− go cpp@(CppUseNamespace{}) = Just cpp
38− go (CppFunction _ [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp _ [_])])) | atyp == Just CppAuto
39− = Just CppNoOp
40− go (CppFunction name args rtyp qs _) =
41− let args' = (\(_,t) -> ("", t)) <$> args in
42− Just (CppFunction name args' rtyp qs CppNoOp)
43− go (CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
44− Nothing
45− go (CppVariableIntroduction _ _ (Just CppStringLiteral {})) =
46− Nothing
47− go (CppVariableIntroduction _ _ (Just CppBooleanLiteral {})) =
48− Nothing
49− -- Generate thunks for top-level values
50− go (CppVariableIntroduction (name, _) _ (Just _)) =
51− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [CppExtern] Nothing
52− go (CppComment comms cpp')
53− | Just cpp <- go cpp' = Just $ case cpp of CppFunction {} -> cpp
54− _ -> CppComment comms cpp
55− go _ = Nothing
56−
57−---------------------------------------------------------------------------------------------------
58−toHeaderFns :: [Cpp] -> [Cpp]
59−---------------------------------------------------------------------------------------------------
60−toHeaderFns = catMaybes . map go
61− where
62− go :: Cpp -> Maybe Cpp
63− go (CppNamespace name cpps) = Just (CppNamespace name (toHeaderFns cpps))
64− go (CppFunction name [(_, atyp)] _ _ (CppBlock [CppReturn (CppApp cpp [_])]))
65− | atyp == Just CppAuto
66− = Just (CppVariableIntroduction (name, Nothing) [] (Just cpp))
67−
68− go cpp@(CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
69− Just cpp
70− go cpp@(CppVariableIntroduction _ _ (Just CppStringLiteral {})) =
71− Just cpp
72− go cpp@(CppVariableIntroduction _ _ (Just CppBooleanLiteral {})) =
73− Just cpp
74−
75− go (CppComment comms cpp') | Just cpp <- go cpp' = Just (CppComment comms cpp)
76− go _ = Nothing
77−
78−---------------------------------------------------------------------------------------------------
79−toBodyDecl :: [Cpp] -> [Cpp]
80−---------------------------------------------------------------------------------------------------
81−toBodyDecl = catMaybes . map go
82− where
83− go :: Cpp -> Maybe Cpp
84− go (CppComment comms cpp') | Just commented <- go cpp' = Just (CppComment comms commented)
85− go _ = Nothing
86−
87−---------------------------------------------------------------------------------------------------
88−toBody :: [Cpp] -> [Cpp]
89−---------------------------------------------------------------------------------------------------
90−toBody = catMaybes . map go
91− where
92− go :: Cpp -> Maybe Cpp
93− go (CppNamespace name cpps) =
94− let cpps' = toBody cpps in
95− if all isNoOp cpps'
96− then Nothing
97− else Just (CppNamespace name cpps')
98− where
99− isNoOp :: Cpp -> Bool
100− isNoOp CppNoOp = True
101− isNoOp (CppComment _ cpp) | isNoOp cpp = True
102− isNoOp (CppUseNamespace{}) = True
103− isNoOp (CppNamespace _ cpps') = all isNoOp cpps'
104− isNoOp (CppRaw _) = True
105− isNoOp _ = False
106− go cpp@(CppUseNamespace{}) = Just cpp
107− go cpp@(CppFunction {}) = Just cpp
108− go (CppVariableIntroduction _ _ (Just CppNumericLiteral {})) =
109− Nothing
110− go (CppVariableIntroduction _ _ (Just CppStringLiteral {})) =
111− Nothing
112− go (CppVariableIntroduction _ _ (Just CppBooleanLiteral {})) =
113− Nothing
114− -- Generate thunks for top-level values
115− go (CppVariableIntroduction (name, _) _ (Just cpp)) =
116− Just $ CppVariableIntroduction (name, Just $ CppAny [CppConst]) [] (Just lambda)
117− where
118− val = CppVariableIntroduction ("_value_", Just $ CppAny [CppConst]) [CppStatic] (Just $ addCaptures cpp)
119− block = CppBlock [val, CppReturn (CppVar "_value_")]
120− lambda = CppLambda [] [("", Just $ thunkMarkerType)] (Just $ CppAny [CppConst, CppRef]) block
121− addCaptures :: Cpp -> Cpp
122− addCaptures = everywhereOnCpp addCapture
123− where
124− addCapture :: Cpp -> Cpp
125− addCapture (CppLambda [] args rty body) = CppLambda [CppCaptureAll] args rty body
126− addCapture cpp' = cpp'
127− go (CppComment comms cpp') | Just commented <- go cpp' = Just (CppComment comms commented)
128− go _ = Nothing
129−
130−---------------------------------------------------------------------------------------------------
131−
132−fileBegin :: ModuleName -> String -> [Cpp]
133−fileBegin mn suffix = [CppRaw ("#ifndef " ++ fileModName mn suffix),
134− CppRaw ("#define " ++ fileModName mn suffix)]
135−
136−fileEnd :: ModuleName -> String -> [Cpp]
137−fileEnd mn suffix = [CppRaw ("#endif // " ++ fileModName mn suffix)]
138−
139−fileModName :: ModuleName -> String -> String
140−fileModName mn suffix = P.dotsTo '_' (runModuleName mn ++ '_' : suffix)
141−
142−isMain :: ModuleName -> Bool
143−isMain (ModuleName [ProperName "Main"]) = True
144−isMain _ = False
145−
146−nativeMain :: Cpp
147−nativeMain = CppFunction "main"
148− [ ([], Just $ CppPrimitive "int")
149− , ([], Just $ CppPrimitive "char *[]")
150− ]
151− (Just $ CppPrimitive "int")
152− []
153− (CppBlock [ CppUseNamespace "Main"
154− , CppApp (CppApp (CppAccessor (CppVar "main") (CppVar "Main"))
155− [CppVar unthunkMarkerValue])
156− []
157− , CppReturn (CppNumericLiteral (Left 0))
158− ])
src/Language/PureScript/CodeGen/Cpp/Optimizer.hsdeleted−92
@@ -1,92 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.Optimizer
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module optimizes code in the simplified-C++11 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 C++11 operators
31−--
32−-----------------------------------------------------------------------------
33−
34−{-# LANGUAGE FlexibleContexts #-}
35−{-# LANGUAGE CPP #-}
36−
37−module Language.PureScript.CodeGen.Cpp.Optimizer (
38− optimize
39−) where
40−
41−#if __GLASGOW_HASKELL__ < 710
42−import Control.Applicative (Applicative)
43−#endif
44−import Control.Monad.Reader (MonadReader, ask, asks)
45−import Control.Monad.Supply.Class (MonadSupply)
46−
47−import Language.PureScript.CodeGen.Cpp.AST
48−import Language.PureScript.Options
49−import qualified Language.PureScript.Constants as C
50−
51−import Language.PureScript.CodeGen.Cpp.Optimizer.Blocks
52−import Language.PureScript.CodeGen.Cpp.Optimizer.Common
53−import Language.PureScript.CodeGen.Cpp.Optimizer.Inliner
54−import Language.PureScript.CodeGen.Cpp.Optimizer.MagicDo
55−import Language.PureScript.CodeGen.Cpp.Optimizer.TCO
56−import Language.PureScript.CodeGen.Cpp.Optimizer.Unused
57−
58−-- |
59−-- Apply a series of optimizer passes to simplified C++11 code
60−--
61−optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => Cpp -> m Cpp
62−optimize cpp = do
63− noOpt <- asks optionsNoOptimizations
64− if noOpt then return cpp else optimize' cpp
65−
66−optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => Cpp -> m Cpp
67−optimize' cpp = do
68− opts <- ask
69− untilFixedPoint (inlineFnComposition . applyAll
70− [ collapseNestedBlocks
71− , collapseNestedIfs
72− , tco opts
73− , magicDo opts
74− , removeCodeAfterReturnStatements
75− , removeUnusedArg
76− , removeUndefinedApp
77− , unThunk
78− , etaConvert
79− , evaluateIifes
80− , inlineVariables
81− , inlineValues
82− , inlineOperator (C.prelude, (C.$)) $ \f x -> CppApp f [x]
83− , inlineOperator (C.prelude, (C.#)) $ \x f -> CppApp f [x]
84− , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip CppIndexer
85− , inlineCommonOperators ]) cpp
86−
87−untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
88−untilFixedPoint f = go
89− where
90− go a = do
91− a' <- f a
92− if a' == a then return a' else go a'
src/Language/PureScript/CodeGen/Cpp/Optimizer/Blocks.hsdeleted−42
@@ -1,42 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.Optimizer.Blocks
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Optimizer steps for simplifying C++ blocks
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.Cpp.Optimizer.Blocks
17− ( collapseNestedBlocks
18− , collapseNestedIfs
19− ) where
20−
21−import Language.PureScript.CodeGen.Cpp.AST
22−
23−-- |
24−-- Collapse blocks which appear nested directly below another block
25−--
26−collapseNestedBlocks :: Cpp -> Cpp
27−collapseNestedBlocks = everywhereOnCpp collapse
28− where
29− collapse :: Cpp -> Cpp
30− collapse (CppBlock sts) = CppBlock (concatMap go sts)
31− collapse cpp = cpp
32− go :: Cpp -> [Cpp]
33− go (CppBlock sts) = sts
34− go s = [s]
35−
36−collapseNestedIfs :: Cpp -> Cpp
37−collapseNestedIfs = everywhereOnCpp collapse
38− where
39− collapse :: Cpp -> Cpp
40− collapse (CppIfElse cond1 (CppBlock [CppIfElse cond2 body Nothing]) Nothing) =
41− CppIfElse (CppBinary And cond1 cond2) body Nothing
42− collapse cpp = cpp
src/Language/PureScript/CodeGen/Cpp/Optimizer/Common.hsdeleted−75
@@ -1,75 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.Optimizer.Common
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Common functions used by the various optimizer phases
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.Cpp.Optimizer.Common where
17−
18−import Data.Maybe (fromMaybe)
19−
20−import Language.PureScript.CodeGen.Cpp.AST
21−
22−applyAll :: [a -> a] -> a -> a
23−applyAll = foldl1 (.)
24−
25−replaceIdent :: String -> Cpp -> Cpp -> Cpp
26−replaceIdent var1 cpp = everywhereOnCpp replace
27− where
28− replace (CppVar var2) | var1 == var2 = cpp
29− replace other = other
30−
31−replaceIdents :: [(String, Cpp)] -> Cpp -> Cpp
32−replaceIdents vars = everywhereOnCpp replace
33− where
34− replace v@(CppVar var) = fromMaybe v $ lookup var vars
35− replace other = other
36−
37−isReassigned :: String -> Cpp -> Bool
38−isReassigned var1 = everythingOnCpp (||) check
39− where
40− check :: Cpp -> Bool
41− check (CppFunction _ args _ _ _) | var1 `elem` (map fst args) = True
42− check (CppVariableIntroduction arg _ _) | var1 == fst arg = True
43− check (CppAssignment (CppVar arg) _) | var1 == arg = True
44− check _ = False
45−
46−isRebound :: Cpp -> Cpp -> Bool
47−isRebound cpp d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnCpp (++) variablesOf cpp)
48− where
49− variablesOf (CppVar var) = [var]
50− variablesOf _ = []
51−
52−isUsed :: String -> Cpp -> Bool
53−isUsed var1 = everythingOnCpp (||) check
54− where
55− check :: Cpp -> Bool
56− check (CppVar var2) | var1 == var2 = True
57− check (CppAssignment target _) | var1 == targetVariable target = True
58− check _ = False
59−
60−targetVariable :: Cpp -> String
61−targetVariable (CppVar var) = var
62−targetVariable (CppAccessor _ tgt) = targetVariable tgt
63−targetVariable (CppIndexer _ tgt) = targetVariable tgt
64−targetVariable _ = error "Invalid argument to targetVariable"
65−
66−isUpdated :: String -> Cpp -> Bool
67−isUpdated var1 = everythingOnCpp (||) check
68− where
69− check :: Cpp -> Bool
70− check (CppAssignment target _) | var1 == targetVariable target = True
71− check _ = False
72−
73−removeFromBlock :: ([Cpp] -> [Cpp]) -> Cpp -> Cpp
74−removeFromBlock go (CppBlock sts) = CppBlock (go sts)
75−removeFromBlock _ cpp = cpp
src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hsdeleted−319
@@ -1,319 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.Optimizer.Inliner
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module provides basic inlining capabilities
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE CPP #-}
17−
18−module Language.PureScript.CodeGen.Cpp.Optimizer.Inliner (
19− inlineVariables,
20− inlineValues,
21− inlineOperator,
22− inlineCommonOperators,
23− inlineFnComposition,
24− etaConvert,
25− unThunk,
26− evaluateIifes
27−) where
28−
29−#if __GLASGOW_HASKELL__ < 710
30−import Control.Applicative (Applicative)
31−#endif
32−import Control.Monad.Supply.Class (MonadSupply, freshName)
33−import Language.PureScript.CodeGen.Cpp.Types
34−import Language.PureScript.CodeGen.Cpp.AST
35−import Language.PureScript.CodeGen.Cpp.Common
36−import Language.PureScript.CodeGen.Cpp.Optimizer.Common
37−import Language.PureScript.Names
38−import qualified Language.PureScript.Constants as C
39−
40−-- TODO: Potential bug:
41−-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
42−-- Needs to be: { 0..toFixed(10); }
43−-- Probably needs to be fixed in pretty-printer instead.
44−shouldInline :: Cpp -> Bool
45−shouldInline (CppVar _) = True
46−shouldInline (CppNumericLiteral _) = True
47−shouldInline (CppStringLiteral _) = True
48−shouldInline (CppBooleanLiteral _) = True
49−shouldInline (CppAccessor _ val) = shouldInline val
50−shouldInline (CppIndexer index val) = shouldInline index && shouldInline val
51−shouldInline _ = False
52−
53−etaConvert :: Cpp -> Cpp
54−etaConvert = everywhereOnCpp convert
55− where
56− convert :: Cpp -> Cpp
57− convert (CppBlock [CppReturn (CppApp (CppLambda _ idents _ block@(CppBlock body)) args)])
58− | all shouldInline args &&
59− not (any (`isRebound` block) (map (CppVar . fst) idents)) &&
60− not (any (`isRebound` block) args)
61− = CppBlock (map (replaceIdents (zip (map fst idents) args)) body)
62− convert (CppLambda _ [] _ (CppBlock [CppReturn (CppApp fn [])])) = fn
63− convert cpp = cpp
64−
65−unThunk :: Cpp -> Cpp
66−unThunk = everywhereOnCpp convert
67− where
68− convert :: Cpp -> Cpp
69− convert (CppBlock []) = CppBlock []
70− convert (CppBlock cpps) =
71− case last cpps of
72− CppReturn (CppApp (CppLambda _ [] _ (CppBlock body)) []) -> CppBlock $ init cpps ++ body
73− _ -> CppBlock cpps
74− convert cpp = cpp
75−
76−evaluateIifes :: Cpp -> Cpp
77−evaluateIifes = everywhereOnCpp convert
78− where
79− convert :: Cpp -> Cpp
80− convert (CppApp (CppLambda _ [] _ (CppBlock [CppReturn ret])) []) = ret
81− convert cpp = cpp
82−
83−inlineVariables :: Cpp -> Cpp
84−inlineVariables = everywhereOnCpp $ removeFromBlock go
85− where
86− go :: [Cpp] -> [Cpp]
87− go [] = []
88− go (CppVariableIntroduction (var, _) _ (Just cpp) : sts)
89− | shouldInline cpp && not (any (isReassigned var) sts) && not (any (isRebound cpp) sts) && not (any (isUpdated var) sts) =
90− go (map (replaceIdent var cpp) sts)
91− go (s:sts) = s : go sts
92−
93−inlineValues :: Cpp -> Cpp
94−inlineValues = everywhereOnCpp convert
95− where
96− convert :: Cpp -> Cpp
97− convert (CppApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = CppNumericLiteral (Left 0)
98− | isDict semiringNumber dict && isFn fnOne fn = CppNumericLiteral (Left 1)
99− | isDict semiringInt dict && isFn fnZero fn = CppNumericLiteral (Left 0)
100− | isDict semiringInt dict && isFn fnOne fn = CppNumericLiteral (Left 1)
101− | isDict boundedBoolean dict && isFn fnBottom fn = CppBooleanLiteral False
102− | isDict boundedBoolean dict && isFn fnTop fn = CppBooleanLiteral True
103− convert (CppApp (CppApp (CppApp fn [dict]) [x]) [y])
104− | isDict semiringInt dict && isFn fnAdd fn = CppBinary Add x y
105− | isDict semiringInt dict && isFn fnMultiply fn = CppBinary Multiply x y
106− | isDict moduloSemiringInt dict && isFn fnDivide fn = CppBinary Divide x y
107− | isDict ringInt dict && isFn fnSubtract fn = CppBinary Subtract x y
108− convert other = other
109− fnZero = (C.prelude, C.zero)
110− fnOne = (C.prelude, C.one)
111− fnBottom = (C.prelude, C.bottom)
112− fnTop = (C.prelude, C.top)
113− fnAdd = (C.prelude, (C.+))
114− fnDivide = (C.prelude, (C./))
115− fnMultiply = (C.prelude, (C.*))
116− fnSubtract = (C.prelude, (C.-))
117−
118−inlineOperator :: (String, String) -> (Cpp -> Cpp -> Cpp) -> Cpp -> Cpp
119−inlineOperator (m, op) f = everywhereOnCpp convert
120− where
121− convert :: Cpp -> Cpp
122− convert (CppApp (CppApp op' [x]) [y]) | isOp op' = f x y
123− convert other = other
124− isOp (CppAccessor (CppVar longForm) (CppVar m')) = m == m' && longForm == identToCpp (Op op)
125− isOp (CppIndexer (CppStringLiteral op') (CppVar m')) = m == m' && op == op'
126− isOp _ = False
127−
128−inlineCommonOperators :: Cpp -> Cpp
129−inlineCommonOperators = applyAll $
130− [ binary semiringNumber (C.+) Add
131− , binary semiringNumber (C.*) Multiply
132−
133− , binary ringNumber (C.-) Subtract
134− , unary ringNumber C.negate CppNegate
135− , binary ringInt (C.-) Subtract
136− , unary ringInt C.negate CppNegate
137−
138− , binary moduloSemiringNumber (C./) Divide
139− , binary moduloSemiringInt C.mod Modulus
140−
141− , binary eqNumber (C.==) Equal
142− , binary eqNumber (C./=) NotEqual
143− , binary eqInt (C.==) Equal
144− , binary eqInt (C./=) NotEqual
145− , binary eqString (C.==) Equal
146− , binary eqString (C./=) NotEqual
147− , binary eqBoolean (C.==) Equal
148− , binary eqBoolean (C./=) NotEqual
149−
150− , binary ordNumber (C.<) LessThan
151− , binary ordNumber (C.>) GreaterThan
152− , binary ordNumber (C.<=) LessThanOrEqual
153− , binary ordNumber (C.>=) GreaterThanOrEqual
154− , binary ordInt (C.<) LessThan
155− , binary ordInt (C.>) GreaterThan
156− , binary ordInt (C.<=) LessThanOrEqual
157− , binary ordInt (C.>=) GreaterThanOrEqual
158−
159− , binary semigroupString (C.<>) Add
160− , binary semigroupString (C.++) Add
161−
162− , binary booleanAlgebraBoolean (C.&&) And
163− , binary booleanAlgebraBoolean (C.||) Or
164− , binaryFunction booleanAlgebraBoolean C.conj And
165− , binaryFunction booleanAlgebraBoolean C.disj Or
166− , unary booleanAlgebraBoolean C.not CppNot
167−
168− , binary' C.dataIntBits (C..|.) BitwiseOr
169− , binary' C.dataIntBits (C..&.) BitwiseAnd
170− , binary' C.dataIntBits (C..^.) BitwiseXor
171− , binary' C.dataIntBits C.shl ShiftLeft
172− , binary' C.dataIntBits C.shr ShiftRight
173− -- , binary' C.dataIntBits C.zshr ZeroFillShiftRight
174− , unary' C.dataIntBits C.complement CppBitwiseNot
175− ] -- ++ -- DISABLE mkFn/runFn inlining
176− -- [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
177− where
178− binary :: (String, String) -> String -> BinaryOp -> Cpp -> Cpp
179− binary dict opString op = everywhereOnCpp convert
180− where
181− convert :: Cpp -> Cpp
182− convert (CppApp (CppApp (CppApp fn [dict']) [CppStringLiteral x]) [CppStringLiteral y])
183− | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)
184− convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = CppBinary op x y
185− convert other = other
186− binary' :: String -> String -> BinaryOp -> Cpp -> Cpp
187− binary' moduleName opString op = everywhereOnCpp convert
188− where
189− convert :: Cpp -> Cpp
190− convert (CppApp (CppApp fn [x]) [y]) | isFn (moduleName, opString) fn = CppBinary op x y
191− convert other = other
192− binaryFunction :: (String, String) -> String -> BinaryOp -> Cpp -> Cpp
193− binaryFunction dict fnName op = everywhereOnCpp convert
194− where
195− convert :: Cpp -> Cpp
196− convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = CppBinary op x y
197− convert other = other
198− unary :: (String, String) -> String -> CppUnaryOp -> Cpp -> Cpp
199− unary dict fnName op = everywhereOnCpp convert
200− where
201− convert :: Cpp -> Cpp
202− convert (CppApp (CppApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = CppUnary op x
203− convert other = other
204− unary' :: String -> String -> CppUnaryOp -> Cpp -> Cpp
205− unary' moduleName fnName op = everywhereOnCpp convert
206− where
207− convert :: Cpp -> Cpp
208− convert (CppApp fn [x]) | isFn (moduleName, fnName) fn = CppUnary op x
209− convert other = other
210− -- mkFn :: Int -> Cpp -> Cpp
211− -- mkFn 0 = everywhereOnCpp convert
212− -- where
213− -- convert :: Cpp -> Cpp
214− -- convert (CppApp mkFnN [CppLambda caps [_] _ (CppBlock cpp)]) | isNFn C.mkFn 0 mkFnN =
215− -- CppLambda caps [] Nothing (CppBlock cpp)
216− -- convert other = other
217− -- mkFn n = everywhereOnCpp convert
218− -- where
219− -- convert :: Cpp -> Cpp
220− -- convert orig@(CppApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
221− -- case collectArgs n [] fn of
222− -- Just (args, cpp) -> CppLambda [CppCaptureAll] args Nothing (CppBlock cpp)
223− -- Nothing -> orig
224− -- convert other = other
225− -- collectArgs :: Int -> [(String, Maybe CppType)] -> Cpp -> Maybe ([(String, Maybe CppType)], [Cpp])
226− -- collectArgs 1 acc (CppLambda _ [oneArg] _ (CppBlock cpp)) | length acc == n - 1 = Just (reverse (oneArg : acc), cpp)
227− -- collectArgs m acc (CppLambda _ [oneArg] _ (CppBlock [CppReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
228− -- collectArgs _ _ _ = Nothing
229− --
230− -- isNFn :: String -> Int -> Cpp -> Bool
231− -- isNFn prefix n (CppVar name) = name == (prefix ++ show n)
232− -- isNFn prefix n (CppAccessor (CppVar name) (CppVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
233− -- isNFn _ _ _ = False
234− --
235− -- runFn :: Int -> Cpp -> Cpp
236− -- runFn n = everywhereOnCpp convert
237− -- where
238− -- convert :: Cpp -> Cpp
239− -- convert cpp = fromMaybe cpp $ go n [] cpp
240− --
241− -- go :: Int -> [Cpp] -> Cpp -> Maybe Cpp
242− -- go 0 acc (CppApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (CppApp fn acc)
243− -- go m acc (CppApp lhs [arg]) = go (m - 1) (arg : acc) lhs
244− -- go _ _ _ = Nothing
245−
246−-- (f <<< g $ x) = f (g x)
247−-- (f <<< g) = \x -> f (g x)
248−inlineFnComposition :: (Applicative m, MonadSupply m) => Cpp -> m Cpp
249−inlineFnComposition = everywhereOnCppTopDownM convert
250− where
251− convert :: (MonadSupply m) => Cpp -> m Cpp
252− convert (CppApp (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) [z]) | isFnCompose dict' fn =
253− return $ CppApp x [CppApp y [z]]
254− convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isFnCompose dict' fn = do
255− arg <- freshName
256− return $ CppLambda [CppCaptureAll] [(arg, Just (CppAny [CppConst, CppRef]))] (Just $ CppAny []) (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])
257− convert other = return other
258− isFnCompose :: Cpp -> Cpp -> Bool
259− isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn (C.compose) fn)
260−
261−isDict :: (String, String) -> Cpp -> Bool
262−isDict (moduleName, dictName) (CppAccessor (CppVar x) (CppVar y)) = x == dictName && y == moduleName
263−isDict _ _ = False
264−
265−isFn :: (String, String) -> Cpp -> Bool
266−isFn (moduleName, fnName) (CppAccessor (CppVar x) (CppVar y)) = x == (identToCpp (Ident fnName)) && y == moduleName
267−isFn (moduleName, fnName) (CppIndexer (CppStringLiteral x) (CppVar y)) = x == fnName && y == moduleName
268−isFn _ _ = False
269−
270−isPreludeFn :: String -> Cpp -> Bool
271−isPreludeFn fnName = isFn (C.prelude, fnName)
272−
273−semiringNumber :: (String, String)
274−semiringNumber = (C.prelude, C.semiringNumber)
275−
276−semiringInt :: (String, String)
277−semiringInt = (C.prelude, C.semiringInt)
278−
279−ringNumber :: (String, String)
280−ringNumber = (C.prelude, C.ringNumber)
281−
282−ringInt :: (String, String)
283−ringInt = (C.prelude, C.ringInt)
284−
285−moduloSemiringNumber :: (String, String)
286−moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
287−
288−moduloSemiringInt :: (String, String)
289−moduloSemiringInt = (C.prelude, C.moduloSemiringInt)
290−
291−eqNumber :: (String, String)
292−eqNumber = (C.prelude, C.eqNumber)
293−
294−eqInt :: (String, String)
295−eqInt = (C.prelude, C.eqInt)
296−
297−eqString :: (String, String)
298−eqString = (C.prelude, C.eqNumber)
299−
300−eqBoolean :: (String, String)
301−eqBoolean = (C.prelude, C.eqNumber)
302−
303−ordNumber :: (String, String)
304−ordNumber = (C.prelude, C.ordNumber)
305−
306−ordInt :: (String, String)
307−ordInt = (C.prelude, C.ordInt)
308−
309−semigroupString :: (String, String)
310−semigroupString = (C.prelude, C.semigroupString)
311−
312−boundedBoolean :: (String, String)
313−boundedBoolean = (C.prelude, C.boundedBoolean)
314−
315−booleanAlgebraBoolean :: (String, String)
316−booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)
317−
318−semigroupoidFn :: (String, String)
319−semigroupoidFn = (C.prelude, C.semigroupoidFn)
src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hsdeleted−117
@@ -1,117 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.Optimizer.MagicDo
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
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.Cpp.Optimizer.MagicDo (
18− magicDo
19−) where
20−
21−import Language.PureScript.CodeGen.Cpp.AST
22−import Language.PureScript.CodeGen.Cpp.Common
23−import Language.PureScript.CodeGen.Cpp.Types
24−import Language.PureScript.Names
25−import Language.PureScript.Options
26−import qualified Language.PureScript.Constants as C
27−
28−magicDo :: Options -> Cpp -> Cpp
29−magicDo opts | optionsNoMagicDo opts = id
30− | otherwise = magicDo'
31−
32−-- |
33−-- Inline type class dictionaries for >>= and return for the Eff monad
34−--
35−-- E.g.
36−--
37−-- Prelude[">>="](dict)(m1)(function(x) {
38−-- return ...;
39−-- })
40−--
41−-- becomes
42−--
43−-- function __do {
44−-- var x = m1();
45−-- ...
46−-- }
47−--
48−magicDo' :: Cpp -> Cpp
49−magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert
50− where
51− -- The name of the function block which is added to denote a do block
52− fnName = "__do"
53− -- Desugar monomorphic calls to >>= and return for the Eff monad
54− convert :: Cpp -> Cpp
55− -- Desugar return
56− convert (CppApp (CppApp ret [val]) []) | isReturn ret = val
57− -- Desugar pure
58− convert (CppApp (CppApp pure' [val]) []) | isPure pure' = val
59− -- Desugar >>
60− convert (CppApp (CppApp bind [m]) [CppLambda _ [] rty (CppBlock cpp)]) | isBind bind =
61− CppFunction fnName [] rty [] $ CppBlock (CppApp m [] : map applyReturns cpp )
62− -- Desugar >>=
63− convert (CppApp (CppApp bind [m]) [CppLambda _ [arg] rty (CppBlock cpp)]) | isBind bind =
64− CppFunction fnName [] rty [] $ CppBlock (CppVariableIntroduction arg [] (Just (CppApp m [])) : map applyReturns cpp)
65− -- Desugar untilE
66− convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =
67− CppApp (CppLambda [CppCaptureAll] [] (Just $ CppAny []) (CppBlock [ CppWhile (CppUnary CppNot (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral []])) []
68− -- Desugar whileE
69− convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
70− CppApp (CppLambda [CppCaptureAll] [] (Just $ CppAny []) (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []
71− convert other = other
72− -- Check if an expression represents a monomorphic call to >>= for the Eff monad
73− isBind (CppApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True
74− isBind _ = False
75− -- Check if an expression represents a monomorphic call to return for the Eff monad
76− isReturn (CppApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True
77− isReturn _ = False
78− -- Check if an expression represents a monomorphic call to pure for the Eff applicative
79− isPure (CppApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
80− isPure _ = False
81− -- Check if an expression represents the polymorphic >>= function
82− isBindPoly (CppAccessor (CppVar prop) (CppVar prelude)) = prelude == C.prelude && (prop `elem` map identToCpp [Ident C.bind, Op (C.>>=)])
83− isBindPoly (CppIndexer (CppStringLiteral bind) (CppVar prelude)) = prelude == C.prelude && (bind `elem` [C.bind, (C.>>=)])
84− isBindPoly _ = False
85− -- Check if an expression represents the polymorphic return function
86− isRetPoly (CppAccessor (CppVar returnEscaped) (CppVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
87− isRetPoly (CppIndexer (CppStringLiteral return') (CppVar prelude)) = prelude == C.prelude && return' == C.return
88− isRetPoly _ = False
89− -- Check if an expression represents the polymorphic pure function
90− isPurePoly (CppAccessor (CppVar pure') (CppVar prelude)) = prelude == C.prelude && pure' == C.pure'
91− isPurePoly (CppIndexer (CppStringLiteral pure') (CppVar prelude)) = prelude == C.prelude && pure' == C.pure'
92− isPurePoly _ = False
93− -- Check if an expression represents a function in the Ef module
94− isEffFunc name (CppAccessor (CppVar name') (CppVar eff)) = eff == C.eff && name == name'
95− isEffFunc _ _ = False
96− -- Check if an expression represents the Monad Eff dictionary
97− isEffDict name (CppVar ident) | ident == name = True
98− isEffDict name (CppAccessor (CppVar prop) (CppVar eff)) = eff == C.eff && prop == name
99− isEffDict _ _ = False
100− -- Remove __do function applications which remain after desugaring
101− undo :: Cpp -> Cpp
102− undo (CppReturn (CppApp (CppFunction ident [] _ _ body) [])) | ident == fnName = body
103− undo (CppFunction ident [] rty _ body) | ident == fnName = CppLambda [CppCaptureAll] [] rty body
104− undo other = other
105−
106− applyReturns :: Cpp -> Cpp
107− applyReturns (CppReturn ret) = CppReturn (CppApp ret [])
108− applyReturns (CppBlock cpps) = CppBlock (map applyReturns cpps)
109− applyReturns (CppWhile cond cpp) = CppWhile cond (applyReturns cpp)
110− applyReturns (CppIfElse cond t f) = CppIfElse cond (applyReturns t) (applyReturns `fmap` f)
111− applyReturns other = other
112−
113−-- |
114−-- Inline functions in the ST module
115−--
116−-- TODO: various issues in C++ backend -- revisit later
117−--
src/Language/PureScript/CodeGen/Cpp/Optimizer/TCO.hsdeleted−149
@@ -1,149 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.Optimizer.TCO
4−-- Copyright : (c) 2013-15 Phil Freeman, Andy Arvanitis, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module implements tail call elimination.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.Cpp.Optimizer.TCO (tco) where
17−
18−import Data.List
19−import Data.Monoid
20−
21−import Language.PureScript.Options
22−import Language.PureScript.CodeGen.Cpp.Types
23−import Language.PureScript.CodeGen.Cpp.AST
24−
25−-- |
26−-- Eliminate tail calls
27−--
28−tco :: Options -> Cpp -> Cpp
29−tco opts | optionsNoTco opts = id
30− | otherwise = tco'
31−
32−tco' :: Cpp -> Cpp
33−tco' = everywhereOnCpp convert
34− where
35− tcoVar :: String -> String
36− tcoVar arg = "__tco_" ++ arg
37−
38− copyVar :: String -> String
39− copyVar arg = "__copy_" ++ arg
40−
41− copyVar' :: (String, Maybe CppType) -> (String, Maybe CppType)
42− copyVar' (arg, t) = (copyVar arg, t)
43−
44− convert :: Cpp -> Cpp
45−
46− convert cpp@(CppVariableIntroduction (name, ty) qs (Just fn@CppLambda {})) =
47− let
48− (argss, body', replace) = collectAllFunctionArgs [] id fn
49− in case () of
50− _ | isTailCall name body' ->
51− let
52− allArgs = fst <$> (concat $ reverse argss)
53− in
54− CppVariableIntroduction (name, ty) qs (Just (replace (toLoop name allArgs body')))
55− | otherwise -> cpp
56−
57− convert fn@(CppFunction name (_:_) _ _ _) =
58− let
59− (argss, body', replace) = collectAllFunctionArgs [] id fn
60− in case () of
61− _ | isTailCall name body' ->
62− let
63− allArgs = fst <$> (concat $ reverse argss)
64− in
65− replace (toLoop name allArgs body')
66− | otherwise -> fn
67−
68− convert cpp = cpp
69−
70− collectAllFunctionArgs :: [[(String, Maybe CppType)]] -> (Cpp -> Cpp) -> Cpp -> ([[(String, Maybe CppType)]], Cpp, Cpp -> Cpp)
71− collectAllFunctionArgs allArgs f (CppFunction ident args rty qs (CppBlock (body@(CppReturn _):_))) =
72− collectAllFunctionArgs (args : allArgs) (\b -> f (CppFunction ident (map copyVar' args) rty qs (CppBlock [b]))) body
73− collectAllFunctionArgs allArgs f (CppFunction ident args rty qs body@(CppBlock _)) =
74− (args : allArgs, body, f . CppFunction ident (map copyVar' args) rty qs)
75− collectAllFunctionArgs allArgs f (CppReturn (CppLambda cs args rty (CppBlock [body]))) =
76− collectAllFunctionArgs (args : allArgs) (\b -> f (CppReturn (CppLambda cs (map copyVar' args) rty (CppBlock [b])))) body
77− collectAllFunctionArgs allArgs f (CppReturn (CppLambda cs args rty body@(CppBlock _))) =
78− (args : allArgs, body, f . CppReturn . CppLambda cs (map copyVar' args) rty)
79− collectAllFunctionArgs allArgs f body = (allArgs, body, f)
80−
81− isTailCall :: String -> Cpp -> Bool
82− isTailCall ident cpp =
83− let
84− numSelfCalls = everythingOnCpp (+) countSelfCalls cpp
85− numSelfCallsInTailPosition = everythingOnCpp (+) countSelfCallsInTailPosition cpp
86− numSelfCallsUnderFunctions = everythingOnCpp (+) countSelfCallsUnderFunctions cpp
87− numSelfCallWithFnArgs = everythingOnCpp (+) countSelfCallsWithFnArgs cpp
88− in
89− numSelfCalls > 0
90− && numSelfCalls == numSelfCallsInTailPosition
91− && numSelfCallsUnderFunctions == 0
92− && numSelfCallWithFnArgs == 0
93− where
94− countSelfCalls :: Cpp -> Int
95− countSelfCalls (CppApp (CppVar ident') _) | ident == ident' = 1
96− countSelfCalls _ = 0
97−
98− countSelfCallsInTailPosition :: Cpp -> Int
99− countSelfCallsInTailPosition (CppReturn ret) | isSelfCall ident ret = 1
100− countSelfCallsInTailPosition _ = 0
101−
102− countSelfCallsUnderFunctions :: Cpp -> Int
103− countSelfCallsUnderFunctions (CppFunction _ _ _ _ cpp') = everythingOnCpp (+) countSelfCalls cpp'
104− countSelfCallsUnderFunctions (CppLambda _ (_:_) _ cpp') = everythingOnCpp (+) countSelfCalls cpp'
105− countSelfCallsUnderFunctions _ = 0
106−
107− countSelfCallsWithFnArgs :: Cpp -> Int
108− countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0
109−
110− toLoop :: String -> [String] -> Cpp -> Cpp
111− toLoop ident allArgs cpp = CppBlock $
112− map (\arg -> CppVariableIntroduction (arg, Just $ CppAny []) [] (Just (CppVar (copyVar arg)))) allArgs ++
113− [ CppWhile (CppBooleanLiteral True) (CppBlock loop) ]
114− where
115− loop :: [Cpp]
116− loop = case everywhereOnCpp loopify cpp of
117− CppReturn (CppApp (CppLambda _ [] _ (CppBlock cpps')) []) -> nub cpps' -- elim dup var intros
118− CppBlock cpps' -> nub cpps'
119− cpp' -> [cpp']
120− loopify :: Cpp -> Cpp
121− loopify (CppReturn ret) | isSelfCall ident ret =
122− let
123− allArgumentValues = concat $ collectSelfCallArgs [] ret
124− in
125− CppBlock $ zipWith (\val arg ->
126− CppVariableIntroduction (tcoVar arg, Just $ CppAny []) [] (Just val)) allArgumentValues allArgs
127− ++ map (\arg ->
128− CppAssignment (CppVar arg) (CppVar (tcoVar arg))) allArgs
129− ++ [ CppContinue ]
130− loopify other = other
131− collectSelfCallArgs :: [[Cpp]] -> Cpp -> [[Cpp]]
132− collectSelfCallArgs allArgumentValues (CppApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
133− collectSelfCallArgs allArgumentValues _ = allArgumentValues
134−
135− isSelfCall :: String -> Cpp -> Bool
136− isSelfCall ident (CppApp (CppVar ident') _) = ident == ident'
137− isSelfCall ident (CppApp fn _) = isSelfCall ident fn
138− isSelfCall _ _ = False
139−
140− isSelfCallWithFnArgs :: String -> Cpp -> [Cpp] -> Bool
141− isSelfCallWithFnArgs ident (CppVar ident') args | ident == ident' && any hasFunction args = True
142− isSelfCallWithFnArgs ident (CppApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)
143− isSelfCallWithFnArgs _ _ _ = False
144−
145− hasFunction :: Cpp -> Bool
146− hasFunction = getAny . everythingOnCpp mappend (Any . isFunction)
147− where
148− isFunction (CppFunction {}) = True
149− isFunction _ = False
src/Language/PureScript/CodeGen/Cpp/Optimizer/Unused.hsdeleted−43
@@ -1,43 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.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.Cpp.Optimizer.Unused where
17−
18−import Language.PureScript.CodeGen.Cpp.AST
19−import Language.PureScript.CodeGen.Cpp.Optimizer.Common
20−
21−import qualified Language.PureScript.Constants as C
22−
23−removeCodeAfterReturnStatements :: Cpp -> Cpp
24−removeCodeAfterReturnStatements = everywhereOnCpp (removeFromBlock go)
25− where
26− go :: [Cpp] -> [Cpp]
27− go cpps | not (any isCppReturn cpps) = cpps
28− | otherwise = let (body, ret : _) = span (not . isCppReturn) cpps in body ++ [ret]
29− isCppReturn (CppReturn _) = True
30− isCppReturn _ = False
31−
32−removeUnusedArg :: Cpp -> Cpp
33−removeUnusedArg = everywhereOnCpp convert
34− where
35− convert (CppFunction name [(arg,atyp)] rtyp qs body)
36− | arg == C.__unused = CppFunction name [("",atyp)] rtyp qs body
37− convert cpp = cpp
38−
39−removeUndefinedApp :: Cpp -> Cpp
40−removeUndefinedApp = everywhereOnCpp convert
41− where
42− convert (CppApp fn [CppVar arg]) | arg == C.undefined = CppApp fn []
43− convert cpp = cpp
src/Language/PureScript/CodeGen/Cpp/Types.hsdeleted−122
@@ -1,122 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Cpp.Types
4−-- Copyright : (c) Andy Arvanitis 2015
5−-- License : MIT
6−--
7−-- Maintainer : Andy Arvanitis <andy.arvanitis@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Types for native C++11 translation
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE PatternGuards #-}
17−{-# LANGUAGE DeriveDataTypeable #-}
18−
19−module Language.PureScript.CodeGen.Cpp.Types where
20−
21−import Data.List
22−import Data.Data
23−
24−import Language.PureScript.CodeGen.Cpp.Common
25−import Language.PureScript.Names
26−import qualified Language.PureScript.Constants as C
27−
28−-- import Debug.Trace
29−
30−data CppType = CppPrimitive String | CppAuto | CppAny [CppTypeQual]
31− deriving (Eq, Show, Data, Typeable)
32−
33−data CppTypeQual = CppConst | CppRef
34− deriving (Eq, Show, Data)
35−
36−-- |
37−-- Value C++11 qualifiers
38−--
39−data CppValueQual
40− -- |
41− -- C++ static qualifier
42− --
43− = CppStatic
44− -- |
45− -- Inline function
46− --
47− | CppInline
48− -- |
49− -- C++11+ constant expression "constexpr"
50− --
51− | CppConstExpr
52− -- |
53− -- Extern value
54− --
55− | CppExtern
56− -- |
57− -- Function or lambda is involved in recursion
58− --
59− | CppRecursive
60−
61− deriving (Show, Eq, Data, Typeable)
62−
63−-- |
64−-- C++ lambda capture list
65−--
66−data CppCaptureType = CppCaptureAll
67− deriving (Show, Eq, Data, Typeable)
68−
69−runType :: CppType -> String
70−runType (CppPrimitive t) = t
71−runType CppAuto = "auto"
72−runType (CppAny qs)
73− | CppConst `elem` qs = "const " ++ (runType . CppAny $ delete CppConst qs)
74− | CppRef `elem` qs = runType (CppAny $ delete CppRef qs) ++ "&"
75− | otherwise = "any"
76−
77−runValueQual :: CppValueQual -> String
78−runValueQual CppStatic = "static"
79−runValueQual CppInline = "inline"
80−runValueQual CppConstExpr = "constexpr"
81−runValueQual CppExtern = "extern"
82−runValueQual CppRecursive = ""
83−
84−runCaptureType :: CppCaptureType -> String
85−runCaptureType CppCaptureAll = "="
86−
87−-- TODO: move or remove this
88−--
89−qualifiedToStr :: ModuleName -> (a -> Ident) -> Qualified a -> String
90−qualifiedToStr _ f (Qualified (Just (ModuleName [ProperName mn])) a) | mn == C.prim = runIdent $ f a
91−qualifiedToStr m f (Qualified (Just m') a) | m /= m' = moduleNameToCpp m' ++ "::" ++ identToCpp (f a)
92−qualifiedToStr _ f (Qualified _ a) = identToCpp (f a)
93−
94−boolType :: CppType
95−boolType = CppPrimitive "bool"
96−
97−intType :: CppType
98−intType = CppPrimitive "long"
99−
100−doubleType :: CppType
101−doubleType = CppPrimitive "double"
102−
103−stringType :: CppType
104−stringType = CppPrimitive "string"
105−
106−charType :: CppType
107−charType = CppPrimitive "char"
108−
109−mapType :: CppType
110−mapType = CppPrimitive "any::map"
111−
112−arrayType :: CppType
113−arrayType = CppPrimitive "any::vector"
114−
115−thunkMarkerType :: CppType
116−thunkMarkerType = CppPrimitive "any::as_thunk"
117−
118−unthunkMarkerValue :: String
119−unthunkMarkerValue = "any::unthunk"
120−
121−ctorKey :: String
122−ctorKey = "constructor"
src/Language/PureScript/CodeGen/JS.hsdeleted−363
@@ -1,363 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module generates code in the simplified Javascript intermediate representation from Purescript code
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE GADTs #-}
17−{-# LANGUAGE ViewPatterns #-}
18−{-# LANGUAGE FlexibleContexts #-}
19−{-# LANGUAGE ScopedTypeVariables #-}
20−{-# LANGUAGE CPP #-}
21−
22−module Language.PureScript.CodeGen.JS
23− ( module AST
24− , module Common
25− , moduleToJs
26− , mainCall
27− ) where
28−
29−import Data.List ((\\), delete, intersect)
30−import Data.Maybe (isNothing)
31−import qualified Data.Traversable as T (traverse)
32−
33−#if __GLASGOW_HASKELL__ < 710
34−import Control.Applicative
35−#endif
36−import Control.Arrow ((&&&))
37−import Control.Monad (replicateM, forM)
38−import Control.Monad.Reader (MonadReader, asks)
39−import Control.Monad.Supply.Class
40−
41−import Language.PureScript.AST.SourcePos
42−import Language.PureScript.CodeGen.JS.AST as AST
43−import Language.PureScript.CodeGen.JS.Common as Common
44−import Language.PureScript.CoreFn
45−import Language.PureScript.Names
46−import Language.PureScript.CodeGen.JS.Optimizer
47−import Language.PureScript.Options
48−import Language.PureScript.Traversals (sndM)
49−import qualified Language.PureScript.Constants as C
50−
51−import System.FilePath.Posix ((</>))
52−
53−-- |
54−-- Generate code in the simplified Javascript intermediate representation for all declarations in a
55−-- module.
56−--
57−moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m)
58− => Module Ann -> Maybe JS -> m [JS]
59−moduleToJs (Module coms mn imps exps foreigns decls) foreign_ = do
60− jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
61− jsDecls <- mapM bindToJs decls
62− optimized <- T.traverse (T.traverse optimize) jsDecls
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− -- Generates Javascript code for a module import.
78− --
79− importToJs :: ModuleName -> m JS
80− importToJs mn' = do
81− path <- asks optionsRequirePath
82− let moduleBody = JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
83− return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
84−
85− -- |
86− -- Generate code in the simplified Javascript intermediate representation for a declaration
87− --
88− bindToJs :: Bind Ann -> m [JS]
89− bindToJs (NonRec ident val) = return <$> nonRecToJS ident val
90− bindToJs (Rec vals) = forM vals (uncurry nonRecToJS)
91−
92− -- |
93− -- Generate code in the simplified Javascript intermediate representation for a single non-recursive
94− -- declaration.
95− --
96− -- The main purpose of this function is to handle code generation for comments.
97− --
98− nonRecToJS :: Ident -> Expr Ann -> m JS
99− nonRecToJS i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
100− withoutComment <- asks optionsNoComments
101− if withoutComment
102− then nonRecToJS i (modifyAnn removeComments e)
103− else JSComment com <$> nonRecToJS i (modifyAnn removeComments e)
104− nonRecToJS ident val = do
105− js <- valueToJs val
106− return $ JSVariableIntroduction (identToJs ident) (Just js)
107−
108− -- |
109− -- Generate code in the simplified Javascript intermediate representation for a variable based on a
110− -- PureScript identifier.
111− --
112− var :: Ident -> JS
113− var = JSVar . identToJs
114−
115− -- |
116− -- Generate code in the simplified Javascript intermediate representation for an accessor based on
117− -- a PureScript identifier. If the name is not valid in Javascript (symbol based, reserved name) an
118− -- indexer is returned.
119− --
120− accessor :: Ident -> JS -> JS
121− accessor (Ident prop) = accessorString prop
122− accessor (Op op) = JSIndexer (JSStringLiteral op)
123−
124− accessorString :: String -> JS -> JS
125− accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)
126− | otherwise = JSAccessor prop
127−
128− -- |
129− -- Generate code in the simplified Javascript intermediate representation for a value or expression.
130− --
131− valueToJs :: Expr Ann -> m JS
132− valueToJs (Literal _ l) =
133− literalToValueJS l
134− valueToJs (Var (_, _, _, Just (IsConstructor _ [])) name) =
135− return $ JSAccessor "value" $ qualifiedToJS id name
136− valueToJs (Var (_, _, _, Just (IsConstructor _ _)) name) =
137− return $ JSAccessor "create" $ qualifiedToJS id name
138− valueToJs (Accessor _ prop val) =
139− accessorString prop <$> valueToJs val
140− valueToJs (ObjectUpdate _ o ps) = do
141− obj <- valueToJs o
142− sts <- mapM (sndM valueToJs) ps
143− extendObj obj sts
144− valueToJs e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
145− let args = unAbs e
146− in return $ JSFunction Nothing (map identToJs args) (JSBlock $ map assign args)
147− where
148− unAbs :: Expr Ann -> [Ident]
149− unAbs (Abs _ arg val) = arg : unAbs val
150− unAbs _ = []
151− assign :: Ident -> JS
152− assign name = JSAssignment (accessorString (runIdent name) (JSVar "this"))
153− (var name)
154− valueToJs (Abs _ arg val) = do
155− ret <- valueToJs val
156− return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
157− valueToJs e@App{} = do
158− let (f, args) = unApp e []
159− args' <- mapM valueToJs args
160− case f of
161− Var (_, _, _, Just IsNewtype) _ -> return (head args')
162− Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields ->
163− return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
164− Var (_, _, _, Just IsTypeClassConstructor) name ->
165− return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
166− _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs f
167− where
168− unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
169− unApp (App _ val arg) args = unApp val (arg : args)
170− unApp other args = (other, args)
171− valueToJs (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =
172− return $ if mn' == mn
173− then foreignIdent ident
174− else varToJs qi
175− valueToJs (Var (_, _, _, Just IsForeign) ident) =
176− error $ "Encountered an unqualified reference to a foreign ident " ++ showQualified showIdent ident
177− valueToJs (Var _ ident) =
178− return $ varToJs ident
179− valueToJs (Case (maybeSpan, _, _, _) values binders) = do
180− vals <- mapM valueToJs values
181− bindersToJs maybeSpan binders vals
182− valueToJs (Let _ ds val) = do
183− ds' <- concat <$> mapM bindToJs ds
184− ret <- valueToJs val
185− return $ JSApp (JSFunction Nothing [] (JSBlock (ds' ++ [JSReturn ret]))) []
186− valueToJs (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =
187− return $ JSVariableIntroduction ctor (Just $
188− JSObjectLiteral [("create",
189− JSFunction Nothing ["value"]
190− (JSBlock [JSReturn $ JSVar "value"]))])
191− valueToJs (Constructor _ _ (ProperName ctor) []) =
192− return $ iife ctor [ JSFunction (Just ctor) [] (JSBlock [])
193− , JSAssignment (JSAccessor "value" (JSVar ctor))
194− (JSUnary JSNew $ JSApp (JSVar ctor) []) ]
195− valueToJs (Constructor _ _ (ProperName ctor) fields) =
196− let constructor =
197− let body = [ JSAssignment (JSAccessor (identToJs f) (JSVar "this")) (var f) | f <- fields ]
198− in JSFunction (Just ctor) (identToJs `map` fields) (JSBlock body)
199− createFn =
200− let body = JSUnary JSNew $ JSApp (JSVar ctor) (var `map` fields)
201− in foldr (\f inner -> JSFunction Nothing [identToJs f] (JSBlock [JSReturn inner])) body fields
202− in return $ iife ctor [ constructor
203− , JSAssignment (JSAccessor "create" (JSVar ctor)) createFn
204− ]
205−
206− iife :: String -> [JS] -> JS
207− iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
208−
209− literalToValueJS :: Literal (Expr Ann) -> m JS
210− literalToValueJS (NumericLiteral n) = return $ JSNumericLiteral n
211− literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
212− literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
213− literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral b
214− literalToValueJS (ArrayLiteral xs) = JSArrayLiteral <$> mapM valueToJs xs
215− literalToValueJS (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM valueToJs) ps
216−
217− -- |
218− -- Shallow copy an object.
219− --
220− extendObj :: JS -> [(String, JS)] -> m JS
221− extendObj obj sts = do
222− newObj <- freshName
223− key <- freshName
224− let
225− jsKey = JSVar key
226− jsNewObj = JSVar newObj
227− block = JSBlock (objAssign:copy:extend ++ [JSReturn jsNewObj])
228− objAssign = JSVariableIntroduction newObj (Just $ JSObjectLiteral [])
229− copy = JSForIn key obj $ JSBlock [JSIfElse cond assign Nothing]
230− cond = JSApp (JSAccessor "hasOwnProperty" obj) [jsKey]
231− assign = JSBlock [JSAssignment (JSIndexer jsKey jsNewObj) (JSIndexer jsKey obj)]
232− stToAssign (s, js) = JSAssignment (JSAccessor s jsNewObj) js
233− extend = map stToAssign sts
234− return $ JSApp (JSFunction Nothing [] block) []
235−
236− -- |
237− -- Generate code in the simplified Javascript intermediate representation for a reference to a
238− -- variable.
239− --
240− varToJs :: Qualified Ident -> JS
241− varToJs (Qualified Nothing ident) = var ident
242− varToJs qual = qualifiedToJS id qual
243−
244− -- |
245− -- Generate code in the simplified Javascript intermediate representation for a reference to a
246− -- variable that may have a qualified name.
247− --
248− qualifiedToJS :: (a -> Ident) -> Qualified a -> JS
249− qualifiedToJS f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = JSVar . runIdent $ f a
250− qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))
251− qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a)
252−
253− foreignIdent :: Ident -> JS
254− foreignIdent ident = accessorString (runIdent ident) (JSVar "$foreign")
255−
256− -- |
257− -- Generate code in the simplified Javascript intermediate representation for pattern match binders
258− -- and guards.
259− --
260− bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [JS] -> m JS
261− bindersToJs maybeSpan binders vals = do
262− valNames <- replicateM (length vals) freshName
263− let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
264− jss <- forM binders $ \(CaseAlternative bs result) -> do
265− ret <- guardsToJs result
266− go valNames ret bs
267− return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ failedPatternError valNames])))
268− []
269− where
270− go :: [String] -> [JS] -> [Binder Ann] -> m [JS]
271− go _ done [] = return done
272− go (v:vs) done' (b:bs) = do
273− done'' <- go vs done' bs
274− binderToJs v done'' b
275− go _ _ _ = error "Invalid arguments to bindersToJs"
276−
277− failedPatternError :: [String] -> JS
278− failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]
279−
280− errorMessage :: String
281− errorMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "
282−
283− valueError :: String -> JS -> JS
284− valueError _ l@(JSNumericLiteral _) = l
285− valueError _ l@(JSStringLiteral _) = l
286− valueError _ l@(JSBooleanLiteral _) = l
287− valueError s _ = JSAccessor "name" . JSAccessor "constructor" $ JSVar s
288−
289− guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]
290− guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
291− cond' <- valueToJs cond
292− done <- valueToJs val
293− return $ JSIfElse cond' (JSBlock [JSReturn done]) Nothing
294− guardsToJs (Right v) = return . JSReturn <$> valueToJs v
295−
296− -- |
297− -- Generate code in the simplified Javascript intermediate representation for a pattern match
298− -- binder.
299− --
300− binderToJs :: String -> [JS] -> Binder Ann -> m [JS]
301− binderToJs _ done (NullBinder{}) = return done
302− binderToJs varName done (LiteralBinder _ l) =
303− literalToBinderJS varName done l
304− binderToJs varName done (VarBinder _ ident) =
305− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
306− binderToJs varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
307− binderToJs varName done b
308− binderToJs varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do
309− js <- go (zip fields bs) done
310− return $ case ctorType of
311− ProductType -> js
312− SumType ->
313− [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS (Ident . runProperName) ctor))
314− (JSBlock js)
315− Nothing]
316− where
317− go :: [(Ident, Binder Ann)] -> [JS] -> m [JS]
318− go [] done' = return done'
319− go ((field, binder) : remain) done' = do
320− argVar <- freshName
321− done'' <- go remain done'
322− js <- binderToJs argVar done'' binder
323− return (JSVariableIntroduction argVar (Just (JSAccessor (identToJs field) (JSVar varName))) : js)
324− binderToJs _ _ ConstructorBinder{} =
325− error "binderToJs: Invalid ConstructorBinder in binderToJs"
326− binderToJs varName done (NamedBinder _ ident binder) = do
327− js <- binderToJs varName done binder
328− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
329−
330− literalToBinderJS :: String -> [JS] -> Literal (Binder Ann) -> m [JS]
331− literalToBinderJS varName done (NumericLiteral num) =
332− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
333− literalToBinderJS varName done (CharLiteral c) =
334− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral [c])) (JSBlock done) Nothing]
335− literalToBinderJS varName done (StringLiteral str) =
336− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
337− literalToBinderJS varName done (BooleanLiteral True) =
338− return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
339− literalToBinderJS varName done (BooleanLiteral False) =
340− return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
341− literalToBinderJS varName done (ObjectLiteral bs) = go done bs
342− where
343− go :: [JS] -> [(String, Binder Ann)] -> m [JS]
344− go done' [] = return done'
345− go done' ((prop, binder):bs') = do
346− propVar <- freshName
347− done'' <- go done' bs'
348− js <- binderToJs propVar done'' binder
349− return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
350− literalToBinderJS varName done (ArrayLiteral bs) = do
351− js <- go done 0 bs
352− return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
353− where
354− go :: [JS] -> Integer -> [Binder Ann] -> m [JS]
355− go done' _ [] = return done'
356− go done' index (binder:bs') = do
357− elVar <- freshName
358− done'' <- go done' (index + 1) bs'
359− js <- binderToJs elVar done'' binder
360− return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
361−
362−mainCall :: ModuleName -> String -> JS
363−mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []
src/Language/PureScript/CodeGen/JS/AST.hsdeleted−349
@@ -1,349 +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−{-# LANGUAGE CPP #-}
18−
19−module Language.PureScript.CodeGen.JS.AST where
20−
21−#if __GLASGOW_HASKELL__ < 710
22−import Control.Applicative (Applicative, (<$>), (<*>))
23−#endif
24−import Control.Monad.Identity
25−import Data.Data
26−#if __GLASGOW_HASKELL__ < 710
27−import Data.Traversable (traverse)
28−#endif
29−
30−import Language.PureScript.Comments
31−import Language.PureScript.Traversals
32−
33−-- |
34−-- Built-in unary operators
35−--
36−data UnaryOperator
37− -- |
38− -- Numeric negation
39− --
40− = Negate
41− -- |
42− -- Boolean negation
43− --
44− | Not
45− -- |
46− -- Bitwise negation
47− --
48− | BitwiseNot
49− -- |
50− -- Numeric unary \'plus\'
51− --
52− | Positive
53− -- |
54− -- Constructor
55− --
56− | JSNew deriving (Show, Read, Eq, Data, Typeable)
57−
58−-- |
59−-- Built-in binary operators
60−--
61−data BinaryOperator
62− -- |
63− -- Numeric addition
64− --
65− = Add
66− -- |
67− -- Numeric subtraction
68− --
69− | Subtract
70− -- |
71− -- Numeric multiplication
72− --
73− | Multiply
74− -- |
75− -- Numeric division
76− --
77− | Divide
78− -- |
79− -- Remainder
80− --
81− | Modulus
82− -- |
83− -- Generic equality test
84− --
85− | EqualTo
86− -- |
87− -- Generic inequality test
88− --
89− | NotEqualTo
90− -- |
91− -- Numeric less-than
92− --
93− | LessThan
94− -- |
95− -- Numeric less-than-or-equal
96− --
97− | LessThanOrEqualTo
98− -- |
99− -- Numeric greater-than
100− --
101− | GreaterThan
102− -- |
103− -- Numeric greater-than-or-equal
104− --
105− | GreaterThanOrEqualTo
106− -- |
107− -- Boolean and
108− --
109− | And
110− -- |
111− -- Boolean or
112− --
113− | Or
114− -- |
115− -- Bitwise and
116− --
117− | BitwiseAnd
118− -- |
119− -- Bitwise or
120− --
121− | BitwiseOr
122− -- |
123− -- Bitwise xor
124− --
125− | BitwiseXor
126− -- |
127− -- Bitwise left shift
128− --
129− | ShiftLeft
130− -- |
131− -- Bitwise right shift
132− --
133− | ShiftRight
134− -- |
135− -- Bitwise right shift with zero-fill
136− --
137− | ZeroFillShiftRight deriving (Show, Read, Eq, Data, Typeable)
138−
139−-- |
140−-- Data type for simplified Javascript expressions
141−--
142−data JS
143− -- |
144− -- A numeric literal
145− --
146− = JSNumericLiteral (Either Integer Double)
147− -- |
148− -- A string literal
149− --
150− | JSStringLiteral String
151− -- |
152− -- A boolean literal
153− --
154− | JSBooleanLiteral Bool
155− -- |
156− -- A unary operator application
157− --
158− | JSUnary UnaryOperator JS
159− -- |
160− -- A binary operator application
161− --
162− | JSBinary BinaryOperator JS JS
163− -- |
164− -- An array literal
165− --
166− | JSArrayLiteral [JS]
167− -- |
168− -- An array indexer expression
169− --
170− | JSIndexer JS JS
171− -- |
172− -- An object literal
173− --
174− | JSObjectLiteral [(String, JS)]
175− -- |
176− -- An object property accessor expression
177− --
178− | JSAccessor String JS
179− -- |
180− -- A function introduction (optional name, arguments, body)
181− --
182− | JSFunction (Maybe String) [String] JS
183− -- |
184− -- Function application
185− --
186− | JSApp JS [JS]
187− -- |
188− -- Variable
189− --
190− | JSVar String
191− -- |
192− -- Conditional expression
193− --
194− | JSConditional JS JS JS
195− -- |
196− -- A block of expressions in braces
197− --
198− | JSBlock [JS]
199− -- |
200− -- A variable introduction and optional initialization
201− --
202− | JSVariableIntroduction String (Maybe JS)
203− -- |
204− -- A variable assignment
205− --
206− | JSAssignment JS JS
207− -- |
208− -- While loop
209− --
210− | JSWhile JS JS
211− -- |
212− -- For loop
213− --
214− | JSFor String JS JS JS
215− -- |
216− -- ForIn loop
217− --
218− | JSForIn String JS JS
219− -- |
220− -- If-then-else statement
221− --
222− | JSIfElse JS JS (Maybe JS)
223− -- |
224− -- Return statement
225− --
226− | JSReturn JS
227− -- |
228− -- Throw statement
229− --
230− | JSThrow JS
231− -- |
232− -- Type-Of operator
233− --
234− | JSTypeOf JS
235− -- |
236− -- InstanceOf test
237− --
238− | JSInstanceOf JS JS
239− -- |
240− -- Labelled statement
241− --
242− | JSLabel String JS
243− -- |
244− -- Break statement
245− --
246− | JSBreak String
247− -- |
248− -- Continue statement
249− --
250− | JSContinue String
251− -- |
252− -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)
253− --
254− | JSRaw String
255− -- |
256− -- Commented Javascript
257− --
258− | JSComment [Comment] JS deriving (Show, Read, Eq, Data, Typeable)
259−
260−--
261−-- Traversals
262−--
263−
264−everywhereOnJS :: (JS -> JS) -> JS -> JS
265−everywhereOnJS f = go
266− where
267− go :: JS -> JS
268− go (JSUnary op j) = f (JSUnary op (go j))
269− go (JSBinary op j1 j2) = f (JSBinary op (go j1) (go j2))
270− go (JSArrayLiteral js) = f (JSArrayLiteral (map go js))
271− go (JSIndexer j1 j2) = f (JSIndexer (go j1) (go j2))
272− go (JSObjectLiteral js) = f (JSObjectLiteral (map (fmap go) js))
273− go (JSAccessor prop j) = f (JSAccessor prop (go j))
274− go (JSFunction name args j) = f (JSFunction name args (go j))
275− go (JSApp j js) = f (JSApp (go j) (map go js))
276− go (JSConditional j1 j2 j3) = f (JSConditional (go j1) (go j2) (go j3))
277− go (JSBlock js) = f (JSBlock (map go js))
278− go (JSVariableIntroduction name j) = f (JSVariableIntroduction name (fmap go j))
279− go (JSAssignment j1 j2) = f (JSAssignment (go j1) (go j2))
280− go (JSWhile j1 j2) = f (JSWhile (go j1) (go j2))
281− go (JSFor name j1 j2 j3) = f (JSFor name (go j1) (go j2) (go j3))
282− go (JSForIn name j1 j2) = f (JSForIn name (go j1) (go j2))
283− go (JSIfElse j1 j2 j3) = f (JSIfElse (go j1) (go j2) (fmap go j3))
284− go (JSReturn js) = f (JSReturn (go js))
285− go (JSThrow js) = f (JSThrow (go js))
286− go (JSTypeOf js) = f (JSTypeOf (go js))
287− go (JSLabel name js) = f (JSLabel name (go js))
288− go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))
289− go (JSComment com j) = f (JSComment com (go j))
290− go other = f other
291−
292−everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
293−everywhereOnJSTopDown f = runIdentity . everywhereOnJSTopDownM (Identity . f)
294−
295−everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS
296−everywhereOnJSTopDownM f = f >=> go
297− where
298− f' = f >=> go
299− go (JSUnary op j) = JSUnary op <$> f' j
300− go (JSBinary op j1 j2) = JSBinary op <$> f' j1 <*> f' j2
301− go (JSArrayLiteral js) = JSArrayLiteral <$> traverse f' js
302− go (JSIndexer j1 j2) = JSIndexer <$> f' j1 <*> f' j2
303− go (JSObjectLiteral js) = JSObjectLiteral <$> traverse (sndM f') js
304− go (JSAccessor prop j) = JSAccessor prop <$> f' j
305− go (JSFunction name args j) = JSFunction name args <$> f' j
306− go (JSApp j js) = JSApp <$> f' j <*> traverse f' js
307− go (JSConditional j1 j2 j3) = JSConditional <$> f' j1 <*> f' j2 <*> f' j3
308− go (JSBlock js) = JSBlock <$> traverse f' js
309− go (JSVariableIntroduction name j) = JSVariableIntroduction name <$> traverse f' j
310− go (JSAssignment j1 j2) = JSAssignment <$> f' j1 <*> f' j2
311− go (JSWhile j1 j2) = JSWhile <$> f' j1 <*> f' j2
312− go (JSFor name j1 j2 j3) = JSFor name <$> f' j1 <*> f' j2 <*> f' j3
313− go (JSForIn name j1 j2) = JSForIn name <$> f' j1 <*> f' j2
314− go (JSIfElse j1 j2 j3) = JSIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
315− go (JSReturn j) = JSReturn <$> f' j
316− go (JSThrow j) = JSThrow <$> f' j
317− go (JSTypeOf j) = JSTypeOf <$> f' j
318− go (JSLabel name j) = JSLabel name <$> f' j
319− go (JSInstanceOf j1 j2) = JSInstanceOf <$> f' j1 <*> f' j2
320− go (JSComment com j) = JSComment com <$> f' j
321− go other = f other
322−
323−everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
324−everythingOnJS (<>) f = go
325− where
326− go j@(JSUnary _ j1) = f j <> go j1
327− go j@(JSBinary _ j1 j2) = f j <> go j1 <> go j2
328− go j@(JSArrayLiteral js) = foldl (<>) (f j) (map go js)
329− go j@(JSIndexer j1 j2) = f j <> go j1 <> go j2
330− go j@(JSObjectLiteral js) = foldl (<>) (f j) (map (go . snd) js)
331− go j@(JSAccessor _ j1) = f j <> go j1
332− go j@(JSFunction _ _ j1) = f j <> go j1
333− go j@(JSApp j1 js) = foldl (<>) (f j <> go j1) (map go js)
334− go j@(JSConditional j1 j2 j3) = f j <> go j1 <> go j2 <> go j3
335− go j@(JSBlock js) = foldl (<>) (f j) (map go js)
336− go j@(JSVariableIntroduction _ (Just j1)) = f j <> go j1
337− go j@(JSAssignment j1 j2) = f j <> go j1 <> go j2
338− go j@(JSWhile j1 j2) = f j <> go j1 <> go j2
339− go j@(JSFor _ j1 j2 j3) = f j <> go j1 <> go j2 <> go j3
340− go j@(JSForIn _ j1 j2) = f j <> go j1 <> go j2
341− go j@(JSIfElse j1 j2 Nothing) = f j <> go j1 <> go j2
342− go j@(JSIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3
343− go j@(JSReturn j1) = f j <> go j1
344− go j@(JSThrow j1) = f j <> go j1
345− go j@(JSTypeOf j1) = f j <> go j1
346− go j@(JSLabel _ j1) = f j <> go j1
347− go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2
348− go j@(JSComment _ j1) = f j <> go j1
349− go other = f other
src/Language/PureScript/CodeGen/JS/Common.hsdeleted−181
@@ -1,181 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Common
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Common code generation utility functions
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Common where
17−
18−import Data.Char
19−import Data.List (intercalate)
20−
21−import Language.PureScript.Names
22−
23−-- |
24−-- Convert an Ident into a valid Javascript identifier:
25−--
26−-- * Alphanumeric characters are kept unmodified.
27−--
28−-- * Reserved javascript identifiers are prefixed with '$$'.
29−--
30−-- * Symbols are prefixed with '$' followed by a symbol name or their ordinal value.
31−--
32−identToJs :: Ident -> String
33−identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name
34−identToJs (Ident name) = concatMap identCharToString name
35−identToJs (Op op) = concatMap identCharToString op
36−
37−-- |
38−-- Test if a string is a valid JS identifier without escaping.
39−--
40−identNeedsEscaping :: String -> Bool
41−identNeedsEscaping s = s /= identToJs (Ident s)
42−
43−-- |
44−-- Attempts to find a human-readable name for a symbol, if none has been specified returns the
45−-- ordinal value.
46−--
47−identCharToString :: Char -> String
48−identCharToString c | isAlphaNum c = [c]
49−identCharToString '_' = "_"
50−identCharToString '.' = "$dot"
51−identCharToString '$' = "$dollar"
52−identCharToString '~' = "$tilde"
53−identCharToString '=' = "$eq"
54−identCharToString '<' = "$less"
55−identCharToString '>' = "$greater"
56−identCharToString '!' = "$bang"
57−identCharToString '#' = "$hash"
58−identCharToString '%' = "$percent"
59−identCharToString '^' = "$up"
60−identCharToString '&' = "$amp"
61−identCharToString '|' = "$bar"
62−identCharToString '*' = "$times"
63−identCharToString '/' = "$div"
64−identCharToString '+' = "$plus"
65−identCharToString '-' = "$minus"
66−identCharToString ':' = "$colon"
67−identCharToString '\\' = "$bslash"
68−identCharToString '?' = "$qmark"
69−identCharToString '@' = "$at"
70−identCharToString '\'' = "$prime"
71−identCharToString c = '$' : show (ord c)
72−
73−-- |
74−-- Checks whether an identifier name is reserved in Javascript.
75−--
76−nameIsJsReserved :: String -> Bool
77−nameIsJsReserved name =
78− name `elem` [ "abstract"
79− , "arguments"
80− , "boolean"
81− , "break"
82− , "byte"
83− , "case"
84− , "catch"
85− , "char"
86− , "class"
87− , "const"
88− , "continue"
89− , "debugger"
90− , "default"
91− , "delete"
92− , "do"
93− , "double"
94− , "else"
95− , "enum"
96− , "eval"
97− , "export"
98− , "extends"
99− , "final"
100− , "finally"
101− , "float"
102− , "for"
103− , "function"
104− , "goto"
105− , "if"
106− , "implements"
107− , "import"
108− , "in"
109− , "instanceof"
110− , "int"
111− , "interface"
112− , "let"
113− , "long"
114− , "native"
115− , "new"
116− , "null"
117− , "package"
118− , "private"
119− , "protected"
120− , "public"
121− , "return"
122− , "short"
123− , "static"
124− , "super"
125− , "switch"
126− , "synchronized"
127− , "this"
128− , "throw"
129− , "throws"
130− , "transient"
131− , "try"
132− , "typeof"
133− , "var"
134− , "void"
135− , "volatile"
136− , "while"
137− , "with"
138− , "yield" ] || properNameIsJsReserved name
139−
140−moduleNameToJs :: ModuleName -> String
141−moduleNameToJs (ModuleName pns) =
142− let name = intercalate "_" (runProperName `map` pns)
143− in if properNameIsJsReserved name then "$$" ++ name else name
144−
145−-- |
146−-- Checks whether a proper name is reserved in Javascript.
147−--
148−properNameIsJsReserved :: String -> Bool
149−properNameIsJsReserved name =
150− name `elem` [ "Infinity"
151− , "NaN"
152− , "Object"
153− , "Function"
154− , "Boolean"
155− , "Error"
156− , "EvalError"
157− , "InternalError"
158− , "RangeError"
159− , "ReferenceError"
160− , "SyntaxError"
161− , "TypeError"
162− , "URIError"
163− , "Number"
164− , "Math"
165− , "Date"
166− , "String"
167− , "RegExp"
168− , "Array"
169− , "Int8Array"
170− , "Uint8Array"
171− , "Uint8ClampedArray"
172− , "Int16Array"
173− , "Uint16Array"
174− , "Int32Array"
175− , "Uint32Array"
176− , "Float32Array"
177− , "Float64Array"
178− , "ArrayBuffer"
179− , "DataView"
180− , "JSON"
181− , "Intl" ]
src/Language/PureScript/CodeGen/JS/Optimizer.hsdeleted−92
@@ -1,92 +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−{-# LANGUAGE CPP #-}
36−
37−module Language.PureScript.CodeGen.JS.Optimizer (
38− optimize
39−) where
40−
41−#if __GLASGOW_HASKELL__ < 710
42−import Control.Applicative (Applicative)
43−#endif
44−import Control.Monad.Reader (MonadReader, ask, asks)
45−import Control.Monad.Supply.Class (MonadSupply)
46−
47−import Language.PureScript.CodeGen.JS.AST
48−import Language.PureScript.Options
49−import qualified Language.PureScript.Constants as C
50−
51−import Language.PureScript.CodeGen.JS.Optimizer.Common
52−import Language.PureScript.CodeGen.JS.Optimizer.TCO
53−import Language.PureScript.CodeGen.JS.Optimizer.MagicDo
54−import Language.PureScript.CodeGen.JS.Optimizer.Inliner
55−import Language.PureScript.CodeGen.JS.Optimizer.Unused
56−import Language.PureScript.CodeGen.JS.Optimizer.Blocks
57−
58−-- |
59−-- Apply a series of optimizer passes to simplified Javascript code
60−--
61−optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
62−optimize js = do
63− noOpt <- asks optionsNoOptimizations
64− if noOpt then return js else optimize' js
65−
66−optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
67−optimize' js = do
68− opts <- ask
69− untilFixedPoint (inlineFnComposition . applyAll
70− [ collapseNestedBlocks
71− , collapseNestedIfs
72− , tco opts
73− , magicDo opts
74− , removeCodeAfterReturnStatements
75− , removeUnusedArg
76− , removeUndefinedApp
77− , unThunk
78− , etaConvert
79− , evaluateIifes
80− , inlineVariables
81− , inlineValues
82− , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
83− , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
84− , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer
85− , inlineCommonOperators ]) js
86−
87−untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
88−untilFixedPoint f = go
89− where
90− go a = do
91− a' <- f a
92− if a' == a then return a' else go a'
src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hsdeleted−42
@@ -1,42 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Blocks
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Optimizer steps for simplifying Javascript blocks
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Blocks
17− ( collapseNestedBlocks
18− , collapseNestedIfs
19− ) where
20−
21−import Language.PureScript.CodeGen.JS.AST
22−
23−-- |
24−-- Collapse blocks which appear nested directly below another block
25−--
26−collapseNestedBlocks :: JS -> JS
27−collapseNestedBlocks = everywhereOnJS collapse
28− where
29− collapse :: JS -> JS
30− collapse (JSBlock sts) = JSBlock (concatMap go sts)
31− collapse js = js
32− go :: JS -> [JS]
33− go (JSBlock sts) = sts
34− go s = [s]
35−
36−collapseNestedIfs :: JS -> JS
37−collapseNestedIfs = everywhereOnJS collapse
38− where
39− collapse :: JS -> JS
40− collapse (JSIfElse cond1 (JSBlock [JSIfElse cond2 body Nothing]) Nothing) =
41− JSIfElse (JSBinary And cond1 cond2) body Nothing
42− collapse js = js
src/Language/PureScript/CodeGen/JS/Optimizer/Common.hsdeleted−77
@@ -1,77 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Common
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Common functions used by the various optimizer phases
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Common where
17−
18−import Data.Maybe (fromMaybe)
19−
20−import Language.PureScript.CodeGen.JS.AST
21−
22−applyAll :: [a -> a] -> a -> a
23−applyAll = foldl1 (.)
24−
25−replaceIdent :: String -> JS -> JS -> JS
26−replaceIdent var1 js = everywhereOnJS replace
27− where
28− replace (JSVar var2) | var1 == var2 = js
29− replace other = other
30−
31−replaceIdents :: [(String, JS)] -> JS -> JS
32−replaceIdents vars = everywhereOnJS replace
33− where
34− replace v@(JSVar var) = fromMaybe v $ lookup var vars
35− replace other = other
36−
37−isReassigned :: String -> JS -> Bool
38−isReassigned var1 = everythingOnJS (||) check
39− where
40− check :: JS -> Bool
41− check (JSFunction _ args _) | var1 `elem` args = True
42− check (JSVariableIntroduction arg _) | var1 == arg = True
43− check (JSAssignment (JSVar arg) _) | var1 == arg = True
44− check (JSFor arg _ _ _) | var1 == arg = True
45− check (JSForIn arg _ _) | var1 == arg = True
46− check _ = False
47−
48−isRebound :: JS -> JS -> Bool
49−isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnJS (++) variablesOf js)
50− where
51− variablesOf (JSVar var) = [var]
52− variablesOf _ = []
53−
54−isUsed :: String -> JS -> Bool
55−isUsed var1 = everythingOnJS (||) check
56− where
57− check :: JS -> Bool
58− check (JSVar var2) | var1 == var2 = True
59− check (JSAssignment target _) | var1 == targetVariable target = True
60− check _ = False
61−
62−targetVariable :: JS -> String
63−targetVariable (JSVar var) = var
64−targetVariable (JSAccessor _ tgt) = targetVariable tgt
65−targetVariable (JSIndexer _ tgt) = targetVariable tgt
66−targetVariable _ = error "Invalid argument to targetVariable"
67−
68−isUpdated :: String -> JS -> Bool
69−isUpdated var1 = everythingOnJS (||) check
70− where
71− check :: JS -> Bool
72− check (JSAssignment target _) | var1 == targetVariable target = True
73− check _ = False
74−
75−removeFromBlock :: ([JS] -> [JS]) -> JS -> JS
76−removeFromBlock go (JSBlock sts) = JSBlock (go sts)
77−removeFromBlock _ js = js
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hsdeleted−318
@@ -1,318 +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−{-# LANGUAGE CPP #-}
17−
18−module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
19− inlineVariables,
20− inlineValues,
21− inlineOperator,
22− inlineCommonOperators,
23− inlineFnComposition,
24− etaConvert,
25− unThunk,
26− evaluateIifes
27−) where
28−
29−#if __GLASGOW_HASKELL__ < 710
30−import Control.Applicative (Applicative)
31−#endif
32−import Control.Monad.Supply.Class (MonadSupply, freshName)
33−import Data.Maybe (fromMaybe)
34−
35−import Language.PureScript.CodeGen.JS.AST
36−import Language.PureScript.CodeGen.JS.Common
37−import Language.PureScript.Names
38−import Language.PureScript.CodeGen.JS.Optimizer.Common
39−import qualified Language.PureScript.Constants as C
40−
41−-- TODO: Potential bug:
42−-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
43−-- Needs to be: { 0..toFixed(10); }
44−-- Probably needs to be fixed in pretty-printer instead.
45−shouldInline :: JS -> Bool
46−shouldInline (JSVar _) = True
47−shouldInline (JSNumericLiteral _) = True
48−shouldInline (JSStringLiteral _) = True
49−shouldInline (JSBooleanLiteral _) = True
50−shouldInline (JSAccessor _ val) = shouldInline val
51−shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
52−shouldInline _ = False
53−
54−etaConvert :: JS -> JS
55−etaConvert = everywhereOnJS convert
56− where
57− convert :: JS -> JS
58− convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
59− | all shouldInline args &&
60− not (any (`isRebound` block) (map JSVar idents)) &&
61− not (any (`isRebound` block) args)
62− = JSBlock (map (replaceIdents (zip idents args)) body)
63− convert (JSFunction Nothing [] (JSBlock [JSReturn (JSApp fn [])])) = fn
64− convert js = js
65−
66−unThunk :: JS -> JS
67−unThunk = everywhereOnJS convert
68− where
69− convert :: JS -> JS
70− convert (JSBlock []) = JSBlock []
71− convert (JSBlock jss) =
72− case last jss of
73− JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
74− _ -> JSBlock jss
75− convert js = js
76−
77−evaluateIifes :: JS -> JS
78−evaluateIifes = everywhereOnJS convert
79− where
80− convert :: JS -> JS
81− convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret
82− convert js = js
83−
84−inlineVariables :: JS -> JS
85−inlineVariables = everywhereOnJS $ removeFromBlock go
86− where
87− go :: [JS] -> [JS]
88− go [] = []
89− go (JSVariableIntroduction var (Just js) : sts)
90− | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
91− go (map (replaceIdent var js) sts)
92− go (s:sts) = s : go sts
93−
94−inlineValues :: JS -> JS
95−inlineValues = everywhereOnJS convert
96− where
97− convert :: JS -> JS
98− convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
99− | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
100− | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
101− | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
102− | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
103− | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
104− convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
105− | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))
106− | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))
107− | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))
108− | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))
109− convert other = other
110− fnZero = (C.prelude, C.zero)
111− fnOne = (C.prelude, C.one)
112− fnBottom = (C.prelude, C.bottom)
113− fnTop = (C.prelude, C.top)
114− fnAdd = (C.prelude, (C.+))
115− fnDivide = (C.prelude, (C./))
116− fnMultiply = (C.prelude, (C.*))
117− fnSubtract = (C.prelude, (C.-))
118−
119−inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
120−inlineOperator (m, op) f = everywhereOnJS convert
121− where
122− convert :: JS -> JS
123− convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y
124− convert other = other
125− isOp (JSAccessor longForm (JSVar m')) = m == m' && longForm == identToJs (Op op)
126− isOp (JSIndexer (JSStringLiteral op') (JSVar m')) = m == m' && op == op'
127− isOp _ = False
128−
129−inlineCommonOperators :: JS -> JS
130−inlineCommonOperators = applyAll $
131− [ binary semiringNumber (C.+) Add
132− , binary semiringNumber (C.*) Multiply
133−
134− , binary ringNumber (C.-) Subtract
135− , unary ringNumber C.negate Negate
136− , binary ringInt (C.-) Subtract
137− , unary ringInt C.negate Negate
138−
139− , binary moduloSemiringNumber (C./) Divide
140− , binary moduloSemiringInt C.mod Modulus
141−
142− , binary eqNumber (C.==) EqualTo
143− , binary eqNumber (C./=) NotEqualTo
144− , binary eqInt (C.==) EqualTo
145− , binary eqInt (C./=) NotEqualTo
146− , binary eqString (C.==) EqualTo
147− , binary eqString (C./=) NotEqualTo
148− , binary eqBoolean (C.==) EqualTo
149− , binary eqBoolean (C./=) NotEqualTo
150−
151− , binary ordNumber (C.<) LessThan
152− , binary ordNumber (C.>) GreaterThan
153− , binary ordNumber (C.<=) LessThanOrEqualTo
154− , binary ordNumber (C.>=) GreaterThanOrEqualTo
155− , binary ordInt (C.<) LessThan
156− , binary ordInt (C.>) GreaterThan
157− , binary ordInt (C.<=) LessThanOrEqualTo
158− , binary ordInt (C.>=) GreaterThanOrEqualTo
159−
160− , binary semigroupString (C.<>) Add
161− , binary semigroupString (C.++) Add
162−
163− , binary booleanAlgebraBoolean (C.&&) And
164− , binary booleanAlgebraBoolean (C.||) Or
165− , binaryFunction booleanAlgebraBoolean C.conj And
166− , binaryFunction booleanAlgebraBoolean C.disj Or
167− , unary booleanAlgebraBoolean C.not Not
168−
169− , binary' C.dataIntBits (C..|.) BitwiseOr
170− , binary' C.dataIntBits (C..&.) BitwiseAnd
171− , binary' C.dataIntBits (C..^.) BitwiseXor
172− , binary' C.dataIntBits C.shl ShiftLeft
173− , binary' C.dataIntBits C.shr ShiftRight
174− , binary' C.dataIntBits C.zshr ZeroFillShiftRight
175− , unary' C.dataIntBits C.complement BitwiseNot
176− ] ++
177− [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
178− where
179− binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
180− binary dict opString op = everywhereOnJS convert
181− where
182− convert :: JS -> JS
183− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = JSBinary op x y
184− convert other = other
185− binary' :: String -> String -> BinaryOperator -> JS -> JS
186− binary' moduleName opString op = everywhereOnJS convert
187− where
188− convert :: JS -> JS
189− convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
190− convert other = other
191− binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS
192− binaryFunction dict fnName op = everywhereOnJS convert
193− where
194− convert :: JS -> JS
195− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = JSBinary op x y
196− convert other = other
197− unary :: (String, String) -> String -> UnaryOperator -> JS -> JS
198− unary dict fnName op = everywhereOnJS convert
199− where
200− convert :: JS -> JS
201− convert (JSApp (JSApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = JSUnary op x
202− convert other = other
203− unary' :: String -> String -> UnaryOperator -> JS -> JS
204− unary' moduleName fnName op = everywhereOnJS convert
205− where
206− convert :: JS -> JS
207− convert (JSApp fn [x]) | isFn (moduleName, fnName) fn = JSUnary op x
208− convert other = other
209− mkFn :: Int -> JS -> JS
210− mkFn 0 = everywhereOnJS convert
211− where
212− convert :: JS -> JS
213− convert (JSApp mkFnN [JSFunction Nothing [_] (JSBlock js)]) | isNFn C.mkFn 0 mkFnN =
214− JSFunction Nothing [] (JSBlock js)
215− convert other = other
216− mkFn n = everywhereOnJS convert
217− where
218− convert :: JS -> JS
219− convert orig@(JSApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
220− case collectArgs n [] fn of
221− Just (args, js) -> JSFunction Nothing args (JSBlock js)
222− Nothing -> orig
223− convert other = other
224− collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])
225− collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
226− collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
227− collectArgs _ _ _ = Nothing
228−
229− isNFn :: String -> Int -> JS -> Bool
230− isNFn prefix n (JSVar name) = name == (prefix ++ show n)
231− isNFn prefix n (JSAccessor name (JSVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
232− isNFn _ _ _ = False
233−
234− runFn :: Int -> JS -> JS
235− runFn n = everywhereOnJS convert
236− where
237− convert :: JS -> JS
238− convert js = fromMaybe js $ go n [] js
239−
240− go :: Int -> [JS] -> JS -> Maybe JS
241− go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
242− go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
243− go _ _ _ = Nothing
244−
245−-- (f <<< g $ x) = f (g x)
246−-- (f <<< g) = \x -> f (g x)
247−inlineFnComposition :: (Applicative m, MonadSupply m) => JS -> m JS
248−inlineFnComposition = everywhereOnJSTopDownM convert
249− where
250− convert :: (MonadSupply m) => JS -> m JS
251− convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isFnCompose dict' fn =
252− return $ JSApp x [JSApp y [z]]
253− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isFnCompose dict' fn = do
254− arg <- freshName
255− return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
256− convert other = return other
257− isFnCompose :: JS -> JS -> Bool
258− isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn C.compose fn)
259−
260−isDict :: (String, String) -> JS -> Bool
261−isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
262−isDict _ _ = False
263−
264−isFn :: (String, String) -> JS -> Bool
265−isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
266−isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
267−isFn _ _ = False
268−
269−isPreludeFn :: String -> JS -> Bool
270−isPreludeFn fnName = isFn (C.prelude, fnName)
271−
272−semiringNumber :: (String, String)
273−semiringNumber = (C.prelude, C.semiringNumber)
274−
275−semiringInt :: (String, String)
276−semiringInt = (C.prelude, C.semiringInt)
277−
278−ringNumber :: (String, String)
279−ringNumber = (C.prelude, C.ringNumber)
280−
281−ringInt :: (String, String)
282−ringInt = (C.prelude, C.ringInt)
283−
284−moduloSemiringNumber :: (String, String)
285−moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
286−
287−moduloSemiringInt :: (String, String)
288−moduloSemiringInt = (C.prelude, C.moduloSemiringInt)
289−
290−eqNumber :: (String, String)
291−eqNumber = (C.prelude, C.eqNumber)
292−
293−eqInt :: (String, String)
294−eqInt = (C.prelude, C.eqInt)
295−
296−eqString :: (String, String)
297−eqString = (C.prelude, C.eqNumber)
298−
299−eqBoolean :: (String, String)
300−eqBoolean = (C.prelude, C.eqNumber)
301−
302−ordNumber :: (String, String)
303−ordNumber = (C.prelude, C.ordNumber)
304−
305−ordInt :: (String, String)
306−ordInt = (C.prelude, C.ordInt)
307−
308−semigroupString :: (String, String)
309−semigroupString = (C.prelude, C.semigroupString)
310−
311−boundedBoolean :: (String, String)
312−boundedBoolean = (C.prelude, C.boundedBoolean)
313−
314−booleanAlgebraBoolean :: (String, String)
315−booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)
316−
317−semigroupoidFn :: (String, String)
318−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−48
@@ -1,48 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Binders
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The core functional representation for binders
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−{-# LANGUAGE DeriveFunctor #-}
17−
18−module Language.PureScript.CoreFn.Binders where
19−
20−import qualified Data.Data as D
21−
22−import Language.PureScript.CoreFn.Literals
23−import Language.PureScript.Names
24−
25−-- |
26−-- Data type for binders
27−--
28−data Binder a
29− -- |
30− -- Wildcard binder
31− --
32− = NullBinder a
33− -- |
34− -- A binder which matches a literal value
35− --
36− | LiteralBinder a (Literal (Binder a))
37− -- |
38− -- A binder which binds an identifier
39− --
40− | VarBinder a Ident
41− -- |
42− -- A binder which matches a data constructor (type name, constructor name, binders)
43− --
44− | ConstructorBinder a (Qualified ProperName) (Qualified ProperName) [Binder a]
45− -- |
46− -- A binder which binds its input to an identifier
47− --
48− | NamedBinder a Ident (Binder a) deriving (Show, Read, D.Data, D.Typeable, Functor)
src/Language/PureScript/CoreFn/Desugar.hsdeleted−265
@@ -1,265 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Desugar
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>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The AST -> CoreFn desugaring step
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.CoreFn.Desugar (moduleToCoreFn) where
16−
17−import Data.Function (on)
18−import Data.List (sort, sortBy, nub)
19−import Data.Maybe (mapMaybe)
20−import qualified Data.Map as M
21−
22−import Control.Arrow (second, (***))
23−
24−import Language.PureScript.AST.SourcePos
25−import Language.PureScript.AST.Traversals
26−import Language.PureScript.CoreFn.Ann
27−import Language.PureScript.CoreFn.Binders
28−import Language.PureScript.CoreFn.Expr
29−import Language.PureScript.CoreFn.Literals
30−import Language.PureScript.CoreFn.Meta
31−import Language.PureScript.CoreFn.Module
32−import Language.PureScript.Environment
33−import Language.PureScript.Names
34−import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDictionaryNames)
35−import Language.PureScript.Types
36−import Language.PureScript.Comments
37−import qualified Language.PureScript.AST as A
38−
39−-- |
40−-- Desugars a module from AST to CoreFn representation.
41−--
42−moduleToCoreFn :: Environment -> A.Module -> Module Ann
43−moduleToCoreFn _ (A.Module _ _ _ _ Nothing) =
44− error "Module exports were not elaborated before moduleToCoreFn"
45−moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =
46− let imports = nub $ mapMaybe importToCoreFn decls ++ findQualModules decls
47− exps' = nub $ concatMap exportToCoreFn exps
48− externs = nub $ mapMaybe externToCoreFn decls
49− decls' = concatMap (declToCoreFn Nothing []) decls
50− in Module coms mn imports exps' externs decls'
51−
52− where
53−
54− -- |
55− -- Desugars member declarations from AST to CoreFn representation.
56− --
57− declToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Declaration -> [Bind Ann]
58− declToCoreFn ss com (A.DataDeclaration Newtype _ _ [(ctor, _)]) =
59− [NonRec (properToIdent ctor) $
60− Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var nullAnn $ Qualified Nothing (Ident "x"))]
61− declToCoreFn _ _ d@(A.DataDeclaration Newtype _ _ _) =
62− error $ "Found newtype with multiple constructors: " ++ show d
63− declToCoreFn ss com (A.DataDeclaration Data tyName _ ctors) =
64− flip map ctors $ \(ctor, _) ->
65− let (_, _, _, fields) = lookupConstructor env (Qualified (Just mn) ctor)
66− in NonRec (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields
67− declToCoreFn ss _ (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn ss []) ds
68− declToCoreFn ss com (A.ValueDeclaration name _ _ (Right e)) =
69− [NonRec name (exprToCoreFn ss com Nothing e)]
70− declToCoreFn ss _ (A.BindingGroupDeclaration ds) =
71− [Rec $ map (\(name, _, e) -> (name, exprToCoreFn ss [] Nothing e)) ds]
72− declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =
73− [NonRec (properToIdent name) $ mkTypeClassConstructor ss com supers members]
74− declToCoreFn _ com (A.PositionedDeclaration ss com1 d) =
75− declToCoreFn (Just ss) (com ++ com1) d
76− declToCoreFn _ _ _ = []
77−
78− -- |
79− -- Desugars expressions from AST to CoreFn representation.
80− --
81− exprToCoreFn :: Maybe SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann
82− exprToCoreFn ss com ty (A.NumericLiteral v) =
83− Literal (ss, com, ty, Nothing) (NumericLiteral v)
84− exprToCoreFn ss com ty (A.StringLiteral v) =
85− Literal (ss, com, ty, Nothing) (StringLiteral v)
86− exprToCoreFn ss com ty (A.CharLiteral v) =
87− Literal (ss, com, ty, Nothing) (CharLiteral v)
88− exprToCoreFn ss com ty (A.BooleanLiteral v) =
89− Literal (ss, com, ty, Nothing) (BooleanLiteral v)
90− exprToCoreFn ss com ty (A.ArrayLiteral vs) =
91− Literal (ss, com, ty, Nothing) (ArrayLiteral $ map (exprToCoreFn ss [] Nothing) vs)
92− exprToCoreFn ss com ty (A.ObjectLiteral vs) =
93− Literal (ss, com, ty, Nothing) (ObjectLiteral $ map (second (exprToCoreFn ss [] Nothing)) vs)
94− exprToCoreFn ss com ty (A.Accessor name v) =
95− Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
96− exprToCoreFn ss com ty (A.ObjectUpdate obj vs) =
97− ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ map (second (exprToCoreFn ss [] Nothing)) vs
98− exprToCoreFn ss com ty (A.Abs (Left name) v) =
99− Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
100− exprToCoreFn _ _ _ (A.Abs _ _) =
101− error "Abs with Binder argument was not desugared before exprToCoreFn mn"
102− exprToCoreFn ss com ty (A.App v1 v2) =
103− App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)
104− exprToCoreFn ss com ty (A.Var ident) =
105− Var (ss, com, ty, getValueMeta ident) ident
106− exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =
107− Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]
108− [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]
109− (Right $ exprToCoreFn Nothing [] Nothing v2)
110− , CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral False]
111− (Right $ exprToCoreFn Nothing [] Nothing v3) ]
112− exprToCoreFn ss com ty (A.Constructor name) =
113− Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name
114− exprToCoreFn ss com ty (A.Case vs alts) =
115− Case (ss, com, ty, Nothing) (map (exprToCoreFn ss [] Nothing) vs) (map (altToCoreFn ss) alts)
116− exprToCoreFn ss com _ (A.TypedValue _ v ty) =
117− exprToCoreFn ss com (Just ty) v
118− exprToCoreFn ss com ty (A.Let ds v) =
119− Let (ss, com, ty, Nothing) (concatMap (declToCoreFn ss []) ds) (exprToCoreFn ss [] Nothing v)
120− exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ (A.ObjectLiteral vs) _)) =
121− let args = map (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs
122− ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)
123− in foldl (App (ss, com, Nothing, Nothing)) ctor args
124− exprToCoreFn ss com ty (A.TypeClassDictionaryAccessor _ ident) =
125− Abs (ss, com, ty, Nothing) (Ident "dict")
126− (Accessor nullAnn (runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))
127− exprToCoreFn _ com ty (A.PositionedValue ss com1 v) =
128− exprToCoreFn (Just ss) (com ++ com1) ty v
129− exprToCoreFn _ _ _ e =
130− error $ "Unexpected value in exprToCoreFn mn: " ++ show e
131−
132− -- |
133− -- Desugars case alternatives from AST to CoreFn representation.
134− --
135− altToCoreFn :: Maybe SourceSpan -> A.CaseAlternative -> CaseAlternative Ann
136− altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn ss []) bs) (go vs)
137− where
138− go :: Either [(A.Guard, A.Expr)] A.Expr -> Either [(Guard Ann, Expr Ann)] (Expr Ann)
139− go (Left ges) = Left $ map (exprToCoreFn ss [] Nothing *** exprToCoreFn ss [] Nothing) ges
140− go (Right e) = Right (exprToCoreFn ss [] Nothing e)
141−
142− -- |
143− -- Desugars case binders from AST to CoreFn representation.
144− --
145− binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann
146− binderToCoreFn ss com (A.NullBinder) =
147− NullBinder (ss, com, Nothing, Nothing)
148− binderToCoreFn ss com (A.BooleanBinder b) =
149− LiteralBinder (ss, com, Nothing, Nothing) (BooleanLiteral b)
150− binderToCoreFn ss com (A.StringBinder s) =
151− LiteralBinder (ss, com, Nothing, Nothing) (StringLiteral s)
152− binderToCoreFn ss com (A.CharBinder c) =
153− LiteralBinder (ss, com, Nothing, Nothing) (CharLiteral c)
154− binderToCoreFn ss com (A.NumberBinder n) =
155− LiteralBinder (ss, com, Nothing, Nothing) (NumericLiteral n)
156− binderToCoreFn ss com (A.VarBinder name) =
157− VarBinder (ss, com, Nothing, Nothing) name
158− binderToCoreFn ss com (A.ConstructorBinder dctor@(Qualified mn' _) bs) =
159− let (_, tctor, _, _) = lookupConstructor env dctor
160− in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (map (binderToCoreFn ss []) bs)
161− binderToCoreFn ss com (A.ObjectBinder bs) =
162− LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn ss [])) bs)
163− binderToCoreFn ss com (A.ArrayBinder bs) =
164− LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn ss []) bs)
165− binderToCoreFn ss com (A.NamedBinder name b) =
166− NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)
167− binderToCoreFn _ com (A.PositionedBinder ss com1 b) =
168− binderToCoreFn (Just ss) (com ++ com1) b
169− binderToCoreFn ss com (A.TypedBinder _ b) =
170− binderToCoreFn ss com b
171−
172− -- |
173− -- Gets metadata for values.
174− --
175− getValueMeta :: Qualified Ident -> Maybe Meta
176− getValueMeta name =
177− case lookupValue env name of
178− Just (_, External, _) -> Just IsForeign
179− _ -> Nothing
180−
181− -- |
182− -- Gets metadata for data constructors.
183− --
184− getConstructorMeta :: Qualified ProperName -> Meta
185− getConstructorMeta ctor =
186− case lookupConstructor env ctor of
187− (Newtype, _, _, _) -> IsNewtype
188− dc@(Data, _, _, fields) ->
189− let constructorType = if numConstructors (ctor, dc) == 1 then ProductType else SumType
190− in IsConstructor constructorType fields
191− where
192− numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> Int
193− numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors env
194− typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> (ModuleName, ProperName)
195− typeConstructor (Qualified (Just mn') _, (_, tyCtor, _, _)) = (mn', tyCtor)
196− typeConstructor _ = error "Invalid argument to typeConstructor"
197−
198−-- |
199−-- Find module names from qualified references to values. This is used to
200−-- ensure instances are imported from any module that is referenced by the
201−-- current module, not just from those that are imported explicitly (#667).
202−--
203−findQualModules :: [A.Declaration] -> [ModuleName]
204−findQualModules decls =
205− let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues fqBinders (const []) (const [])
206− in f `concatMap` decls
207− where
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 -> Ident
265−properToIdent = Ident . runProperName
src/Language/PureScript/CoreFn/Expr.hsdeleted−134
@@ -1,134 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Expr
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The core functional representation
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−{-# LANGUAGE DeriveFunctor #-}
17−
18−module Language.PureScript.CoreFn.Expr where
19−
20−import Control.Arrow ((***))
21−
22−import qualified Data.Data as D
23−
24−import Language.PureScript.CoreFn.Binders
25−import Language.PureScript.CoreFn.Literals
26−import Language.PureScript.Names
27−
28−-- |
29−-- Data type for expressions and terms
30−--
31−data Expr a
32− -- |
33− -- A literal value
34− --
35− = Literal a (Literal (Expr a))
36− -- |
37− -- A data constructor (type name, constructor name, field names)
38− --
39− | Constructor a ProperName ProperName [Ident]
40− -- |
41− -- A record property accessor
42− --
43− | Accessor a String (Expr a)
44− -- |
45− -- Partial record update
46− --
47− | ObjectUpdate a (Expr a) [(String, Expr a)]
48− -- |
49− -- Function introduction
50− --
51− | Abs a Ident (Expr a)
52− -- |
53− -- Function application
54− --
55− | App a (Expr a) (Expr a)
56− -- |
57− -- Variable
58− --
59− | Var a (Qualified Ident)
60− -- |
61− -- A case expression
62− --
63− | Case a [Expr a] [CaseAlternative a]
64− -- |
65− -- A let binding
66− --
67− | Let a [Bind a] (Expr a) deriving (Show, Read, D.Data, D.Typeable, Functor)
68−
69−-- |
70−-- A let or module binding.
71−--
72−data Bind a
73− -- |
74− -- Non-recursive binding for a single value
75− --
76− = NonRec Ident (Expr a)
77− -- |
78− -- Mutually recursive binding group for several values
79− --
80− | Rec [(Ident, Expr a)] deriving (Show, Read, D.Data, D.Typeable, Functor)
81−
82−-- |
83−-- A guard is just a boolean-valued expression that appears alongside a set of binders
84−--
85−type Guard a = Expr a
86−
87−-- |
88−-- An alternative in a case statement
89−--
90−data CaseAlternative a = CaseAlternative
91− { -- |
92− -- A collection of binders with which to match the inputs
93− --
94− caseAlternativeBinders :: [Binder a]
95− -- |
96− -- The result expression or a collect of guarded expressions
97− --
98− , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
99− } deriving (Show, Read, D.Data, D.Typeable)
100−
101−instance Functor CaseAlternative where
102−
103− fmap f (CaseAlternative cabs car) = CaseAlternative
104− (fmap (fmap f) cabs)
105− (either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)
106−
107−-- |
108−-- Extract the annotation from a term
109−--
110−extractAnn :: Expr a -> a
111−extractAnn (Literal a _) = a
112−extractAnn (Constructor a _ _ _) = a
113−extractAnn (Accessor a _ _) = a
114−extractAnn (ObjectUpdate a _ _) = a
115−extractAnn (Abs a _ _) = a
116−extractAnn (App a _ _) = a
117−extractAnn (Var a _) = a
118−extractAnn (Case a _ _) = a
119−extractAnn (Let a _ _) = a
120−
121−
122−-- |
123−-- Modify the annotation on a term
124−--
125−modifyAnn :: (a -> a) -> Expr a -> Expr a
126−modifyAnn f (Literal a b) = Literal (f a) b
127−modifyAnn f (Constructor a b c d) = Constructor (f a) b c d
128−modifyAnn f (Accessor a b c) = Accessor (f a) b c
129−modifyAnn f (ObjectUpdate a b c) = ObjectUpdate (f a) b c
130−modifyAnn f (Abs a b c) = Abs (f a) b c
131−modifyAnn f (App a b c) = App (f a) b c
132−modifyAnn f (Var a b) = Var (f a) b
133−modifyAnn f (Case a b c) = Case (f a) b c
134−modifyAnn f (Let a b c) = Let (f a) b c
src/Language/PureScript/CoreFn/Literals.hsdeleted−50
@@ -1,50 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CoreFn.Literals
4−-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | The core functional representation for literal values.
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable #-}
16−{-# LANGUAGE DeriveFunctor #-}
17−
18−module Language.PureScript.CoreFn.Literals where
19−
20−import qualified Data.Data as D
21−
22−-- |
23−-- Data type for literal values. Parameterised so it can be used for Exprs and
24−-- Binders.
25−--
26−data Literal a
27− -- |
28− -- A numeric literal
29− --
30− = NumericLiteral (Either Integer Double)
31− -- |
32− -- A string literal
33− --
34− | StringLiteral String
35− -- |
36− -- A character literal
37− --
38− | CharLiteral Char
39− -- |
40− -- A boolean literal
41− --
42− | BooleanLiteral Bool
43− -- |
44− -- An array literal
45− --
46− | ArrayLiteral [a]
47− -- |
48− -- An object literal
49− --
50− | ObjectLiteral [(String, a)] deriving (Show, 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

This diff is too big to show here.

src/Language/PureScript/Docs.hsdeleted−14

This diff is too big to show here.

src/Language/PureScript/Docs/AsMarkdown.hsdeleted−124

This diff is too big to show here.

src/Language/PureScript/Docs/Convert.hsdeleted−226

This diff is too big to show here.

src/Language/PureScript/Docs/ParseAndDesugar.hsdeleted−146

This diff is too big to show here.

src/Language/PureScript/Docs/Render.hsdeleted−128

This diff is too big to show here.

src/Language/PureScript/Docs/RenderedCode.hsdeleted−11

This diff is too big to show here.

src/Language/PureScript/Docs/RenderedCode/Render.hsdeleted−184

This diff is too big to show here.

src/Language/PureScript/Docs/RenderedCode/Types.hsdeleted−194

This diff is too big to show here.

src/Language/PureScript/Docs/Types.hsdeleted−513

This diff is too big to show here.

src/Language/PureScript/Docs/Utils/MonoidExtras.hsdeleted−9

This diff is too big to show here.

src/Language/PureScript/Environment.hsdeleted−272

This diff is too big to show here.

src/Language/PureScript/Errors.hsdeleted−967

This diff is too big to show here.

src/Language/PureScript/Externs.hsdeleted−216

This diff is too big to show here.

src/Language/PureScript/Kinds.hsdeleted−75

This diff is too big to show here.

src/Language/PureScript/Linter.hsdeleted−119

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/Make.hsdeleted−387

This diff is too big to show here.

src/Language/PureScript/ModuleDependencies.hsdeleted−79

This diff is too big to show here.

src/Language/PureScript/Names.hsdeleted−120

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

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

This diff is too big to show here.

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

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

This diff is too big to show here.

src/Language/PureScript/Pretty.hsdeleted−32

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/Pretty/Cpp.hsdeleted−427

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/Publish.hsdeleted−366

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

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

This diff is too big to show here.

src/Language/PureScript/Sugar.hsdeleted−79

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/Traversals.hsdeleted−45

This diff is too big to show here.

src/Language/PureScript/TypeChecker.hsdeleted−365

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Language/PureScript/TypeClassDictionaries.hsdeleted−62

This diff is too big to show here.

src/Language/PureScript/Types.hsdeleted−315

This diff is too big to show here.

src/System/IO/UTF8.hsdeleted−9

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

This diff is too big to show here.

tests/common/TestsSetup.hsdeleted−48

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/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.