├── .cache ├── git │ ├── config │ └── hooks │ │ └── pre-push └── vale │ ├── Vocab │ └── categorifier │ │ └── accept.txt │ └── config │ └── vocabularies │ └── categorifier │ └── accept.txt ├── .config ├── emacs │ └── .dir-locals.el ├── mustache.yaml └── project │ ├── default.nix │ ├── github-ci.nix │ └── hlint.nix ├── .dir-locals.el ├── .editorconfig ├── .envrc ├── .gitattributes ├── .github ├── renovate.json ├── settings.yml └── workflows │ ├── build.yml │ └── flakehub-publish.yml ├── .gitignore ├── .hlint.yaml ├── .vale.ini ├── CHANGELOG.md ├── LICENSE ├── README.md ├── cabal.project ├── category ├── Categorifier │ └── Category.hs └── categorifier-category.cabal ├── client ├── Categorifier │ ├── Client.hs │ └── Client │ │ └── Internal.hs ├── categorifier-client.cabal └── test │ └── Main.hs ├── common ├── Categorifier │ └── Common │ │ └── IO │ │ └── Exception.hs └── categorifier-common.cabal ├── duoids ├── Categorifier │ ├── Duoidal.hs │ └── Duoidal │ │ └── Either.hs └── categorifier-duoids.cabal ├── flake.lock ├── flake.nix ├── garnix.yaml ├── ghc ├── Categorifier │ └── GHC │ │ ├── Builtin.hs │ │ ├── Core.hs │ │ ├── Data.hs │ │ ├── Driver.hs │ │ ├── HsToCore.hs │ │ ├── Plugins.hs │ │ ├── Runtime.hs │ │ ├── Tc.hs │ │ ├── Types.hs │ │ ├── Unit.hs │ │ └── Utils.hs └── categorifier-ghc.cabal ├── hedgehog ├── Categorifier │ └── Hedgehog.hs └── categorifier-hedgehog.cabal ├── integrations ├── adjunctions │ ├── integration-test │ │ ├── Categorifier │ │ │ └── Test │ │ │ │ └── Adjunctions.hs │ │ ├── categorifier-adjunctions-integration-test.cabal │ │ └── test │ │ │ └── Adjunctions │ │ │ └── Main.hs │ └── integration │ │ ├── Categorifier │ │ └── Adjunctions │ │ │ └── Integration.hs │ │ └── categorifier-adjunctions-integration.cabal ├── categories │ ├── integration-test │ │ ├── Categorifier │ │ │ └── Test │ │ │ │ └── Categories │ │ │ │ └── Instances.hs │ │ ├── categorifier-categories-integration-test.cabal │ │ └── test │ │ │ └── Categories │ │ │ └── Main.hs │ └── integration │ │ ├── Categorifier │ │ └── Hierarchy │ │ │ └── Categories.hs │ │ └── categorifier-categories-integration.cabal ├── concat-extensions │ ├── category │ │ ├── Categorifier │ │ │ └── ConCatExtensions.hs │ │ └── categorifier-concat-extensions-category.cabal │ ├── integration-test │ │ ├── Categorifier │ │ │ └── Test │ │ │ │ └── ConCatExtensions │ │ │ │ └── Instances.hs │ │ ├── categorifier-concat-extensions-integration-test.cabal │ │ └── test │ │ │ └── ConCatExtensions │ │ │ └── Main.hs │ └── integration │ │ ├── Categorifier │ │ └── Hierarchy │ │ │ └── ConCatExtensions.hs │ │ └── categorifier-concat-extensions-integration.cabal ├── concat │ ├── examples │ │ ├── Categorifier │ │ │ └── ConCat │ │ │ │ └── Examples │ │ │ │ └── Syntactic.hs │ │ └── categorifier-concat-examples.cabal │ ├── integration-test │ │ ├── Categorifier │ │ │ └── Test │ │ │ │ ├── ConCat │ │ │ │ └── Instances.hs │ │ │ │ └── TotOrd.hs │ │ ├── categorifier-concat-integration-test.cabal │ │ └── test │ │ │ └── ConCat │ │ │ └── Main.hs │ └── integration │ │ ├── Categorifier │ │ └── Hierarchy │ │ │ └── ConCat.hs │ │ └── categorifier-concat-integration.cabal ├── fin │ └── integration │ │ ├── Categorifier │ │ └── Fin │ │ │ └── Client.hs │ │ └── categorifier-fin-integration.cabal ├── ghc-bignum │ ├── integration-test │ │ ├── Categorifier │ │ │ └── Test │ │ │ │ └── GhcBignum.hs │ │ ├── categorifier-ghc-bignum-integration-test.cabal │ │ └── test │ │ │ └── GhcBignum │ │ │ └── Main.hs │ └── integration │ │ ├── Categorifier │ │ └── GhcBignum │ │ │ └── Integration.hs │ │ └── categorifier-ghc-bignum-integration.cabal ├── linear-base │ ├── integration-test │ │ ├── Categorifier │ │ │ └── Test │ │ │ │ └── LinearBase.hs │ │ ├── categorifier-linear-base-integration-test.cabal │ │ └── test │ │ │ └── LinearBase │ │ │ └── Main.hs │ └── integration │ │ ├── Categorifier │ │ └── LinearBase │ │ │ ├── Client.hs │ │ │ └── Integration.hs │ │ └── categorifier-linear-base-integration.cabal ├── unconcat │ ├── category │ │ ├── Categorifier │ │ │ └── UnconCat.hs │ │ └── categorifier-unconcat-category.cabal │ ├── integration-test │ │ ├── Categorifier │ │ │ └── Test │ │ │ │ └── UnconCat │ │ │ │ └── Instances.hs │ │ ├── categorifier-unconcat-integration-test.cabal │ │ └── test │ │ │ └── UnconCat │ │ │ └── Main.hs │ └── integration │ │ ├── Categorifier │ │ └── Hierarchy │ │ │ └── UnconCat.hs │ │ └── categorifier-unconcat-integration.cabal └── vec │ ├── integration-test │ ├── Categorifier │ │ └── Test │ │ │ ├── Vec.hs │ │ │ └── Vec │ │ │ └── Instances.hs │ ├── categorifier-vec-integration-test.cabal │ └── test │ │ └── Vec │ │ └── Main.hs │ └── integration │ ├── Categorifier │ └── Vec │ │ ├── Client.hs │ │ └── Integration.hs │ └── categorifier-vec-integration.cabal ├── plugin-test ├── Categorifier │ └── Test │ │ ├── Data.hs │ │ ├── HList.hs │ │ ├── Hask.hs │ │ ├── TH.hs │ │ ├── Term.hs │ │ └── Tests.hs ├── categorifier-plugin-test.cabal └── test │ ├── Base │ └── Main.hs │ └── Main.hs ├── plugin ├── Categorifier.hs ├── Categorifier │ ├── Benchmark.hs │ ├── Categorify.hs │ ├── CommandLineOptions.hs │ ├── Core.hs │ ├── Core │ │ ├── Base.hs │ │ ├── Benchmark.hs │ │ ├── BuildDictionary.hs │ │ ├── Categorify.hs │ │ ├── ErrorHandling.hs │ │ ├── Functions.hs │ │ ├── MakerMap.hs │ │ ├── Makers.hs │ │ ├── PrimOp.hs │ │ ├── Trace.hs │ │ └── Types.hs │ ├── Hierarchy.hs │ └── Test │ │ ├── CategorizeException.hs │ │ ├── Chaos.hs │ │ ├── PartialApplication.hs │ │ ├── WithInstance.hs │ │ └── WithInstance │ │ └── Main.hs ├── README.md └── categorifier-plugin.cabal └── th ├── Categorifier └── TH.hs └── categorifier-th.cabal /.cache/git/config: -------------------------------------------------------------------------------- 1 | ; This file was generated by Project Manager. 2 | [commit "template"] 3 | contents = "" 4 | path = ".config/git/template/commit.txt" 5 | 6 | [core] 7 | hooksPath = "../.cache/git/hooks" 8 | -------------------------------------------------------------------------------- /.cache/git/hooks/pre-push: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | nix flake check 4 | -------------------------------------------------------------------------------- /.cache/vale/Vocab/categorifier/accept.txt: -------------------------------------------------------------------------------- 1 | direnv 2 | garnix 3 | [Nn]ix 4 | Pfeil 5 | ShellCheck 6 | bugfix 7 | Categorifier 8 | categorified 9 | categorify 10 | comonad 11 | Conal 12 | concat 13 | conditionalize 14 | functor 15 | GADT 16 | GHC 17 | Hask 18 | inline 19 | inlining 20 | invasive 21 | Kleisli 22 | Kmett 23 | [Mm]onoidal 24 | monomorphization 25 | pragma 26 | unfolding 27 | -------------------------------------------------------------------------------- /.cache/vale/config/vocabularies/categorifier/accept.txt: -------------------------------------------------------------------------------- 1 | direnv 2 | garnix 3 | [Nn]ix 4 | Pfeil 5 | ShellCheck 6 | bugfix 7 | Categorifier 8 | categorified 9 | categorify 10 | comonad 11 | Conal 12 | concat 13 | conditionalize 14 | functor 15 | GADT 16 | GHC 17 | Hask 18 | inline 19 | inlining 20 | invasive 21 | Kleisli 22 | Kmett 23 | [Mm]onoidal 24 | monomorphization 25 | pragma 26 | unfolding 27 | -------------------------------------------------------------------------------- /.config/emacs/.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil 2 | (fill-column . 100) 3 | (indent-tabs-mode . nil) 4 | (projectile-project-configure-cmd . "nix flake update") 5 | (sentence-end-double-space . nil))) 6 | -------------------------------------------------------------------------------- /.config/mustache.yaml: -------------------------------------------------------------------------------- 1 | { 2 | project: 3 | { 4 | description: "Interpret Haskell programs into any cartesian closed category.", 5 | name: "categorifier", 6 | repo: "con-kitty/categorifier", 7 | summary: "Defining novel interpretations of Haskell programs", 8 | version: "0.1.0.0", 9 | }, 10 | type: { name: "haskell" }, 11 | } 12 | -------------------------------------------------------------------------------- /.config/project/default.nix: -------------------------------------------------------------------------------- 1 | {config, flaky, lib, pkgs, self, ...}: { 2 | project = { 3 | name = "categorifier"; 4 | summary = "Defining novel interpretations of Haskell programs"; 5 | 6 | devPackages = [pkgs.cabal-install]; 7 | }; 8 | 9 | imports = [ 10 | ./github-ci.nix 11 | ./hlint.nix 12 | ]; 13 | 14 | ## dependency management 15 | services.renovate.enable = true; 16 | 17 | ## development 18 | programs = { 19 | direnv.enable = true; 20 | # This should default by whether there is a .git file/dir (and whether it’s 21 | # a file (worktree) or dir determines other things – like where hooks 22 | # are installed. 23 | git = { 24 | enable = true; 25 | ignores = [ 26 | # Cabal build 27 | "dist-newstyle" 28 | ]; 29 | }; 30 | }; 31 | 32 | ## formatting 33 | editorconfig.enable = true; 34 | project.file.".dir-locals.el".source = lib.mkForce ../emacs/.dir-locals.el; 35 | programs = { 36 | treefmt = { 37 | enable = true; 38 | ## Haskell formatter 39 | ## TODO: `validity`, required by Ormolu, fails to build on i686-linux. 40 | programs.ormolu.enable = pkgs.system != "i686-linux"; 41 | }; 42 | vale = { 43 | enable = true; 44 | excludes = [ 45 | "*.cabal" 46 | "*.hs" 47 | "*.lhs" 48 | "./cabal.project" 49 | ]; 50 | vocab.${config.project.name}.accept = [ 51 | "bugfix" 52 | "Categorifier" 53 | "categorified" 54 | "categorify" 55 | "comonad" 56 | "Conal" 57 | "concat" 58 | "conditionalize" 59 | "functor" 60 | "GADT" 61 | "GHC" 62 | "Hask" 63 | "inline" 64 | "inlining" 65 | "invasive" 66 | "Kleisli" 67 | "Kmett" 68 | "[Mm]onoidal" 69 | "monomorphization" 70 | "pragma" 71 | "unfolding" 72 | ]; 73 | }; 74 | }; 75 | 76 | ## CI 77 | services.garnix = { 78 | enable = true; 79 | builds.exclude = [ 80 | # TODO: Remove once garnix-io/issues#17 is fixed. 81 | "devShells.aarch64-darwin.ghc928" 82 | # TODO: Remove once garnix-io/garnix#285 is fixed. 83 | "homeConfigurations.x86_64-darwin-${config.project.name}-example" 84 | # TODO: Remove these and filter the corresponding packages from the flake (see the comments on 85 | # `cabalPackages` for more information. 86 | "devShells.*.ghc8107" 87 | "packages.*.ghc8107_all" 88 | "packages.*.ghc8107_categorifier-ghc-bignum-integration" 89 | "packages.*.ghc8107_categorifier-ghc-bignum-integration-test" 90 | "packages.*.ghc8107_categorifier-linear-base-integration" 91 | "packages.*.ghc8107_categorifier-linear-base-integration-test" 92 | ]; 93 | }; 94 | ## FIXME: Shouldn’t need `mkForce` here (or to duplicate the base contexts). 95 | ## Need to improve module merging. 96 | services.github.settings.branches.main.protection.required_status_checks.contexts = 97 | lib.mkForce 98 | (map (ghc: "CI / build (${ghc}) (pull_request)") self.lib.nonNixTestedGhcVersions 99 | ++ lib.concatMap flaky.lib.garnixChecks ( 100 | lib.concatMap (ghc: [ 101 | (sys: "devShell ghc${ghc} [${sys}]") 102 | (sys: "package ghc${sys}_all [${sys}]") 103 | ]) 104 | self.lib.testedGhcVersions 105 | ++ [ 106 | (sys: "homeConfig ${sys}-${config.project.name}-example") 107 | (sys: "package default [${sys}]") 108 | ## FIXME: These are duplicated from the base config 109 | (sys: "check formatter [${sys}]") 110 | (sys: "devShell default [${sys}]") 111 | ])); 112 | 113 | ## publishing 114 | services.flakehub.enable = true; 115 | services.github.enable = true; 116 | services.github.settings.repository.topics = ["category-theory" "plugin"]; 117 | } 118 | -------------------------------------------------------------------------------- /.config/project/github-ci.nix: -------------------------------------------------------------------------------- 1 | {lib, self, ...}: { 2 | services.github.workflow."build.yml".text = lib.generators.toYAML {} { 3 | name = "CI"; 4 | on = { 5 | push.branches = ["main"]; 6 | pull_request.types = [ 7 | "opened" 8 | "synchronize" 9 | ]; 10 | }; 11 | jobs.build = { 12 | runs-on = "ubuntu-latest"; 13 | strategy = { 14 | fail-fast = false; 15 | ## TODO: Populate this as the difference between supported versions and 16 | ## available nix package sets. 17 | matrix.ghc = self.lib.nonNixTestedGhcVersions; 18 | }; 19 | env.CONFIG = "--enable-tests --enable-benchmarks"; 20 | steps = [ 21 | {uses = "actions/checkout@v2";} 22 | { 23 | uses = "haskell-actions/setup@v2"; 24 | id = "setup-haskell-cabal"; 25 | "with" = { 26 | ghc-version = "\${{ matrix.ghc }}"; 27 | cabal-version = "3.10"; 28 | }; 29 | } 30 | {run = "cabal v2-update";} 31 | {run = "cabal v2-freeze $CONFIG";} 32 | { 33 | uses = "actions/cache@v2"; 34 | "with" = { 35 | path = '' 36 | ''${{ steps.setup-haskell-cabal.outputs.cabal-store }} 37 | dist-newstyle 38 | ''; 39 | key = "\${{ runner.os }}-\${{ matrix.ghc }}-\${{ hashFiles('cabal.project.freeze') }}"; 40 | }; 41 | } 42 | {run = "cabal v2-test all $CONFIG";} 43 | ]; 44 | }; 45 | }; 46 | } 47 | -------------------------------------------------------------------------------- /.config/project/hlint.nix: -------------------------------------------------------------------------------- 1 | {lib, pkgs, ...}: { 2 | ## Haskell linter 3 | programs.treefmt.programs.hlint.enable = true; 4 | ## TODO: Wrap this to find our generated hlint config in the store. 5 | project.devPackages = [pkgs.hlint]; 6 | project.file.".hlint.yaml".text = lib.generators.toYAML {} [ 7 | {fixity = "infixl 4 <*\>";} 8 | {fixity = "infixr 1 =<\<";} 9 | {fixity = "infixr 1 <=\<";} 10 | 11 | {group = {name = "dollar"; enabled = true;};} 12 | {group = {name = "future"; enabled = true;};} 13 | {group = {name = "generalise"; enabled = true;};} 14 | 15 | {ignore = {name = "Eta reduce";};} 16 | {ignore = {name = "Evaluate";};} 17 | {ignore = {name = "Reduce duplication";};} 18 | {ignore = {name = "Use list comprehension";};} 19 | {ignore = {name = "Use section";};} 20 | 21 | { 22 | package = { 23 | name = "monad"; 24 | modules = ["import Control.Monad"]; 25 | }; 26 | } 27 | 28 | { 29 | package = { 30 | name = "traversable"; 31 | modules = [ 32 | "import Data.Foldable" 33 | "import Data.Traversable" 34 | ]; 35 | }; 36 | } 37 | 38 | { 39 | group = { 40 | name = "generalize"; 41 | imports = [ 42 | "package monad" 43 | "package traversable" 44 | ]; 45 | rules = [ 46 | {warn = {lhs = "forM"; rhs = "for";};} 47 | {warn = {lhs = "forM_"; rhs = "for_";};} 48 | {warn = {lhs = "map"; rhs = "fmap";};} 49 | {warn = {lhs = "mapM"; rhs = "traverse";};} 50 | {warn = {lhs = "mapM_"; rhs = "traverse_";};} 51 | {warn = {lhs = "return"; rhs = "pure";};} 52 | {warn = {lhs = "sequence"; rhs = "sequenceA";};} 53 | {warn = {lhs = "sequence_"; rhs = "sequenceA_";};} 54 | ]; 55 | }; 56 | } 57 | 58 | { 59 | group = { 60 | name = "generalize"; 61 | imports = ["package traversable"]; 62 | rules = [ 63 | { 64 | hint = { 65 | lhs = "maybe (pure ())"; 66 | rhs = "traverse_"; 67 | note = "IncreasesLaziness"; 68 | }; 69 | } 70 | {warn = {lhs = "mappend"; rhs = "(<>)";};} 71 | {warn = {lhs = "(++)"; rhs = "(<>)";};} 72 | ]; 73 | }; 74 | } 75 | ]; 76 | } 77 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil 2 | (fill-column . 100) 3 | (indent-tabs-mode . nil) 4 | (projectile-project-configure-cmd . "nix flake update") 5 | (sentence-end-double-space . nil))) 6 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # This file was generated by Project Manager. 2 | root=true 3 | 4 | [*] 5 | binary_next_line=true 6 | charset=utf-8 7 | end_of_line=lf 8 | indent_size=2 9 | indent_style=space 10 | insert_final_newline=true 11 | space_redirects=true 12 | switch_case_indent=true 13 | trim_trailing_whitespace=true 14 | 15 | [*.{diff,patch}] 16 | trim_trailing_whitespace=false 17 | 18 | [*.{el,lisp}] 19 | indent_size=unset 20 | -------------------------------------------------------------------------------- /.envrc: -------------------------------------------------------------------------------- 1 | # This file was generated by Project Manager. 2 | direnv_layout_dir="$PWD/.cache/direnv" 3 | use flake 4 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | /.cache/git/config linguist-generated 2 | /.cache/git/hooks/pre-push linguist-generated 3 | /.cache/vale/Vocab/categorifier/accept.txt linguist-generated 4 | /.cache/vale/config/vocabularies/categorifier/accept.txt linguist-generated 5 | /.dir-locals.el linguist-generated 6 | /.editorconfig linguist-generated 7 | /.envrc linguist-generated 8 | /.gitattributes linguist-generated 9 | /.github/renovate.json linguist-generated 10 | /.github/settings.yml linguist-generated 11 | /.gitignore linguist-generated 12 | /.hlint.yaml linguist-generated 13 | /.vale.ini linguist-generated 14 | /.github/workflows/build.yml linguist-generated 15 | /.github/workflows/flakehub-publish.yml linguist-generated 16 | /garnix.yaml linguist-generated 17 | -------------------------------------------------------------------------------- /.github/renovate.json: -------------------------------------------------------------------------------- 1 | {"$schema":"https://docs.renovatebot.com/renovate-schema.json","extends":["config:base"],"lockFileMaintenance":{"enabled":true},"nix":{"enabled":true}} -------------------------------------------------------------------------------- /.github/settings.yml: -------------------------------------------------------------------------------- 1 | # This file was generated by Project Manager. 2 | {"actions":{"permissions":{"workflow":{"can_approve_pull_request_reviews":true}}},"branches":[{"name":"main","protection":{"allow_force_pushes":false,"enforce_admins":true,"required_linear_history":false,"required_pull_request_reviews":null,"required_status_checks":{"contexts":["CI / build (8.10.1) (pull_request)","CI / build (9.0.1) (pull_request)","CI / build (9.2.1) (pull_request)","CI / build (9.2.2) (pull_request)","devShell ghcghc928 [aarch64-darwin]","devShell ghcghc928 [aarch64-linux]","devShell ghcghc928 [i686-linux]","devShell ghcghc928 [x86_64-linux]","package ghcaarch64-darwin_all [aarch64-darwin]","package ghcaarch64-linux_all [aarch64-linux]","package ghci686-linux_all [i686-linux]","package ghcx86_64-linux_all [x86_64-linux]","devShell ghcghc8107 [aarch64-darwin]","devShell ghcghc8107 [aarch64-linux]","devShell ghcghc8107 [i686-linux]","devShell ghcghc8107 [x86_64-linux]","package ghcaarch64-darwin_all [aarch64-darwin]","package ghcaarch64-linux_all [aarch64-linux]","package ghci686-linux_all [i686-linux]","package ghcx86_64-linux_all [x86_64-linux]","homeConfig aarch64-darwin-categorifier-example","homeConfig aarch64-linux-categorifier-example","homeConfig i686-linux-categorifier-example","homeConfig x86_64-linux-categorifier-example","package default [aarch64-darwin]","package default [aarch64-linux]","package default [i686-linux]","package default [x86_64-linux]","check formatter [aarch64-darwin]","check formatter [aarch64-linux]","check formatter [i686-linux]","check formatter [x86_64-linux]","devShell default [aarch64-darwin]","devShell default [aarch64-linux]","devShell default [i686-linux]","devShell default [x86_64-linux]"],"strict":false},"restrictions":null}}],"labels":[{"color":"","description":"Created automatically by some service or process","name":"automated"},{"color":"#d73a4a","description":"Something isn’t working","name":"bug"},{"color":"#333333","description":"Updates or other changes to dependencies","name":"dependencies"},{"color":"#0075ca","description":"Improvements or additions to documentation","name":"documentation"},{"color":"#a2eeef","description":"New feature or request","name":"enhancement"},{"color":"#7057ff","description":"Good for newcomers","name":"good first issue"},{"color":"#000000","description":"Issues you want contributors to help with.","name":"hacktoberfest"},{"color":"#ff7518","description":"Indicates acceptance for Hacktoberfest criteria, even if not merged yet.","name":"hacktoberfest-accepted"},{"color":"#008672","description":"Extra attention is needed","name":"help wanted"},{"color":"#333333","description":"Unaccepted contributions that haven’t been closed for some reason.","name":"invalid"},{"color":"#d876e3","description":"Further information is requested","name":"question"},{"color":"#ffc0cb","description":"Topic created in bad faith. Services like Hacktoberfest use this to identify bad actors.","name":"spam"},{"color":"#d4af37","description":"Work prioritized by a sponsor","name":"sponsored"}],"repository":{"allow_merge_commit":true,"allow_rebase_merge":false,"allow_squash_merge":false,"default_branch":"main","delete_branch_on_merge":true,"description":"Defining novel interpretations of Haskell programs","enable_automated_security_fixes":true,"enable_vulnerability_alerts":true,"has_downloads":false,"has_issues":true,"has_projects":true,"has_wiki":true,"merge_commit_message":"PR_BODY","merge_commit_title":"PR_TITLE","name":"categorifier","private":false,"topics":"hacktoberfest, category-theory, plugin"}} -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | {"jobs":{"build":{"env":{"CONFIG":"--enable-tests --enable-benchmarks"},"runs-on":"ubuntu-latest","steps":[{"uses":"actions/checkout@v2"},{"id":"setup-haskell-cabal","uses":"haskell-actions/setup@v2","with":{"cabal-version":"3.10","ghc-version":"${{ matrix.ghc }}"}},{"run":"cabal v2-update"},{"run":"cabal v2-freeze $CONFIG"},{"uses":"actions/cache@v2","with":{"key":"${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}","path":"${{ steps.setup-haskell-cabal.outputs.cabal-store }}\ndist-newstyle\n"}},{"run":"cabal v2-test all $CONFIG"}],"strategy":{"fail-fast":false,"matrix":{"ghc":["8.10.1","9.0.1","9.2.1","9.2.2"]}}}},"name":"CI","on":{"pull_request":{"types":["opened","synchronize"]},"push":{"branches":["main"]}}} -------------------------------------------------------------------------------- /.github/workflows/flakehub-publish.yml: -------------------------------------------------------------------------------- 1 | name: "Publish tags to FlakeHub" 2 | on: 3 | push: 4 | tags: 5 | - "v?[0-9]+.[0-9]+.[0-9]+*" 6 | workflow_dispatch: 7 | inputs: 8 | tag: 9 | description: "The existing tag to publish to FlakeHub" 10 | type: "string" 11 | required: true 12 | jobs: 13 | flakehub-publish: 14 | runs-on: "ubuntu-latest" 15 | permissions: 16 | id-token: "write" 17 | contents: "read" 18 | steps: 19 | - uses: "actions/checkout@v4" 20 | with: 21 | ref: "${{ (inputs.tag != null) && format('refs/tags/{0}', inputs.tag) || '' }}" 22 | - uses: "DeterminateSystems/nix-installer-action@main" 23 | - uses: "DeterminateSystems/flakehub-push@main" 24 | with: 25 | visibility: "public" 26 | name: "sellout/categorifier" 27 | tag: "${{ inputs.tag }}" 28 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /result 2 | /source 3 | dist-newstyle 4 | /.cache/vale/* 5 | !/.cache/vale/config/ 6 | /.cache/vale/config/* 7 | !/.cache/vale/config/vocabularies/ 8 | /.cache/vale/config/vocabularies/* 9 | !/.cache/vale/config/vocabularies/categorifier/ 10 | !/.cache/vale/Vocab/ 11 | /.cache/vale/Vocab/* 12 | !/.cache/vale/Vocab/categorifier/ 13 | /.local/state/project-manager/ 14 | /.local/state/nix/profiles/ 15 | /.cache/direnv/ 16 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | [{"fixity":"infixl 4 <*>"},{"fixity":"infixr 1 =<<"},{"fixity":"infixr 1 <=<"},{"group":{"enabled":true,"name":"dollar"}},{"group":{"enabled":true,"name":"future"}},{"group":{"enabled":true,"name":"generalise"}},{"ignore":{"name":"Eta reduce"}},{"ignore":{"name":"Evaluate"}},{"ignore":{"name":"Reduce duplication"}},{"ignore":{"name":"Use list comprehension"}},{"ignore":{"name":"Use section"}},{"package":{"modules":["import Control.Monad"],"name":"monad"}},{"package":{"modules":["import Data.Foldable","import Data.Traversable"],"name":"traversable"}},{"group":{"imports":["package monad","package traversable"],"name":"generalize","rules":[{"warn":{"lhs":"forM","rhs":"for"}},{"warn":{"lhs":"forM_","rhs":"for_"}},{"warn":{"lhs":"map","rhs":"fmap"}},{"warn":{"lhs":"mapM","rhs":"traverse"}},{"warn":{"lhs":"mapM_","rhs":"traverse_"}},{"warn":{"lhs":"return","rhs":"pure"}},{"warn":{"lhs":"sequence","rhs":"sequenceA"}},{"warn":{"lhs":"sequence_","rhs":"sequenceA_"}}]}},{"group":{"imports":["package traversable"],"name":"generalize","rules":[{"hint":{"lhs":"maybe (pure ())","note":"IncreasesLaziness","rhs":"traverse_"}},{"warn":{"lhs":"mappend","rhs":"(<>)"}},{"warn":{"lhs":"(++)","rhs":"(<>)"}}]}}] -------------------------------------------------------------------------------- /.vale.ini: -------------------------------------------------------------------------------- 1 | ; This file was generated by Project Manager. 2 | MinAlertLevel=suggestion 3 | Packages=Microsoft 4 | StylesPath=.cache/vale 5 | Vocab=categorifier 6 | 7 | [*] 8 | BasedOnStyles=Vale, Microsoft 9 | Microsoft.Dashes=NO 10 | Microsoft.GeneralURL=NO 11 | Microsoft.Headings=NO 12 | Microsoft.Quotes=NO 13 | Microsoft.Ranges=NO 14 | Microsoft.Vocab=NO 15 | Microsoft.We=NO 16 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for Categorifier 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | - First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2022, con-kitty 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Categorifier 2 | 3 | ![Build status](https://github.com/con-kitty/categorifier/actions/workflows/build.yml/badge.svg) 4 | [![built with garnix](https://img.shields.io/endpoint.svg?url=https%3A%2F%2Fgarnix.io%2Fapi%2Fbadges%2Fcon-kitty%2Fcategorifier)](https://garnix.io) 5 | [![Packaging status](https://repology.org/badge/tiny-repos/haskell:categorifier.svg)](https://repology.org/project/haskell:categorifier/versions) 6 | [![latest packaged version(s)](https://repology.org/badge/latest-versions/haskell:categorifier.svg)](https://repology.org/project/haskell:categorifier/versions) 7 | 8 | Defining novel interpretations of Haskell programs 9 | 10 | You probably want to look at the [plugin README](./plugin/README.md). 11 | 12 | ## Building 13 | 14 | A Nix flake is provided, so if you are familiar with Nix, that’s the most reliable way to build the project. 15 | 16 | If you‘re not using Nix, the cabal.project file requires at least Cabal 3.8, but the individual projects should work with older versions. 17 | 18 | ## Contributing 19 | 20 | There are compatible [direnv](https://direnv.net/) and [Nix](https://nixos.org/manual/nix/stable/) environments in the repository to make it easy to build, test, etc. everything with consistent versions to help replicate issues. 21 | 22 | This repository is all formatted using [Ormolu](https://github.com/tweag/ormolu). Currently CI runs Ormolu 0.4.0.0, which can be installed by `cabal install ormolu-0.4.0.0`. See the [usage notes](https://github.com/tweag/ormolu#usage) for how to best integrate it with your workflow. But don't let Ormolu get in the way of contributing - CI will catch the formatting, and we can help clean up anything. 23 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | source-repository-package 2 | type: git 3 | location: https://github.com/compiling-to-categories/concat.git 4 | tag: d95c79d23f2728f2ab50497760195fffaf4ba675 5 | subdir: 6 | classes 7 | examples 8 | -- dependency of concat-classes, concat-examples 9 | inline 10 | -- dependency of concat-classes, concat-examples 11 | known 12 | -- dependency of concat-classes 13 | satisfy 14 | 15 | program-options 16 | ghc-options: -Werror 17 | 18 | tests: True 19 | 20 | packages: 21 | ./category/categorifier-category.cabal 22 | ./client/categorifier-client.cabal 23 | ./common/categorifier-common.cabal 24 | ./duoids/categorifier-duoids.cabal 25 | ./ghc/categorifier-ghc.cabal 26 | ./hedgehog/categorifier-hedgehog.cabal 27 | ./integrations/adjunctions/integration/categorifier-adjunctions-integration.cabal 28 | ./integrations/adjunctions/integration-test/categorifier-adjunctions-integration-test.cabal 29 | ./integrations/categories/integration/categorifier-categories-integration.cabal 30 | ./integrations/categories/integration-test/categorifier-categories-integration-test.cabal 31 | ./integrations/concat/examples/categorifier-concat-examples.cabal 32 | ./integrations/concat/integration/categorifier-concat-integration.cabal 33 | ./integrations/concat/integration-test/categorifier-concat-integration-test.cabal 34 | ./integrations/concat-extensions/category/categorifier-concat-extensions-category.cabal 35 | ./integrations/concat-extensions/integration/categorifier-concat-extensions-integration.cabal 36 | ./integrations/concat-extensions/integration-test/categorifier-concat-extensions-integration-test.cabal 37 | ./integrations/fin/integration/categorifier-fin-integration.cabal 38 | ./integrations/unconcat/category/categorifier-unconcat-category.cabal 39 | ./integrations/unconcat/integration/categorifier-unconcat-integration.cabal 40 | ./integrations/unconcat/integration-test/categorifier-unconcat-integration-test.cabal 41 | ./integrations/vec/integration/categorifier-vec-integration.cabal 42 | ./integrations/vec/integration-test/categorifier-vec-integration-test.cabal 43 | ./plugin/categorifier-plugin.cabal 44 | ./plugin-test/categorifier-plugin-test.cabal 45 | ./th/categorifier-th.cabal 46 | if impl(ghc >= 9.0.0) 47 | packages: 48 | ./integrations/ghc-bignum/integration/categorifier-ghc-bignum-integration.cabal 49 | ./integrations/ghc-bignum/integration-test/categorifier-ghc-bignum-integration-test.cabal 50 | ./integrations/linear-base/integration/categorifier-linear-base-integration.cabal 51 | ./integrations/linear-base/integration-test/categorifier-linear-base-integration-test.cabal 52 | -------------------------------------------------------------------------------- /category/Categorifier/Category.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE PolyKinds #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | 7 | -- | Plugin-specific type classes for your category. These are less generally categorical and more 8 | -- tied to specific functionality in `GhcPlugins.CoreExpr` and/or the plugin. 9 | module Categorifier.Category 10 | ( ReferenceCat (..), 11 | ForeignFunCallCat (..), 12 | NativeCat (..), 13 | RepCat (..), 14 | UnsafeCoerceCat (..), 15 | ) 16 | where 17 | 18 | import Categorifier.Client (HasRep (..), Rep) 19 | import GHC.TypeLits (Symbol) 20 | import Unsafe.Coerce (unsafeCoerce) 21 | 22 | -- | This lifts `HasRep` into the target category. 23 | -- 24 | -- __NB__: This is slightly hierarchy-specific. E.g., the base hierarchy doesn't require an 25 | -- instance of this, and while concat has its own version of this, we need to use ours 26 | -- because it has to tie into our `HasRep`. 27 | class (HasRep a, r ~ Rep a) => RepCat k a r where 28 | reprC :: a `k` r 29 | abstC :: r `k` a 30 | 31 | instance (HasRep a, r ~ Rep a) => RepCat (->) a r where 32 | reprC = repr 33 | abstC = abst 34 | 35 | -- | An interface for having something like function calls in your category. The default 36 | -- implementation is basically a NOP, inlining any function calls, but if your category has some 37 | -- way of handling abstraction, then you can provide a real implementation. 38 | class ReferenceCat k a b where 39 | -- | The first parameter is a qualified Haskell identifier (although not necessarily one that 40 | -- exists in the source), and the input arrow is guaranteed to be the same as for any other call 41 | -- with the same first parameter. Be careful when mangling the identifier, to not introduce 42 | -- collisions. 43 | indirection :: String -> a `k` b -> a `k` b 44 | indirection = const id 45 | 46 | -- | This allows a category to define a way to call functions that are defined externally 47 | -- (as opposed to ReferenceCat which allows for internal function calls). 48 | class ForeignFunCallCat k i a b where 49 | ffcall :: i -> Maybe (a -> b) -> a `k` b 50 | 51 | -- | This class provides a backdoor for a user to provide a custom @findMaker@ entry 52 | -- to interpret something that the user doesn't want to or cannot categorify. 53 | -- 54 | -- We use @tag@ instead of @Proxy tag@ here, so that @findMaker@ doesn't have to 55 | -- obtain the @Proxy@ tycon. 56 | class NativeCat k (tag :: Symbol) a b where 57 | nativeK :: a `k` b 58 | 59 | -- | This class is intended to lift `unsafeCoerce` into the target category @k@. This is needed for 60 | -- converting various coercions. 61 | -- 62 | -- __NB__: See compiling-to-categories/concat#34 for more context on this. 63 | class UnsafeCoerceCat k a b where 64 | unsafeCoerceK :: a `k` b 65 | 66 | instance UnsafeCoerceCat (->) a b where 67 | unsafeCoerceK = unsafeCoerce 68 | -------------------------------------------------------------------------------- /category/categorifier-category.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-category 4 | version: 0.1 5 | description: Classes used by categorifier plugin 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Category 43 | other-modules: 44 | Paths_categorifier_category 45 | autogen-modules: 46 | Paths_categorifier_category 47 | ghc-options: 48 | -O2 49 | -Wall 50 | build-depends: 51 | , categorifier-client 52 | -------------------------------------------------------------------------------- /client/Categorifier/Client.hs: -------------------------------------------------------------------------------- 1 | -- `PolyKinds` ensures the derived HasRep instances are fully polymorphic. In future, we could try 2 | -- to make this explicit in `deriveHasRep`. 3 | {-# LANGUAGE PolyKinds #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-# OPTIONS_GHC -Wno-orphans #-} 7 | 8 | -- | The only module that should be needed by code that is in the dependency graph of calls to 9 | -- `Categorifier.Categorify.expression`. If the module actually /calls/ 10 | -- `Categorifier.Categorify.expression`, then it will also need to 11 | -- @import qualified "Categorifier.Categorify" as Categorify@. 12 | module Categorifier.Client 13 | ( HasRep (..), 14 | Rep, 15 | deriveHasRep, 16 | 17 | -- * testing 18 | abstReturn, 19 | reprReturn, 20 | ) 21 | where 22 | 23 | import Categorifier.Client.Internal (HasRep (..), Rep, deriveHasRep) 24 | import Data.Complex (Complex) 25 | import Data.Functor.Compose (Compose) 26 | import Data.Functor.Identity (Identity) 27 | import qualified Data.Functor.Product as Functor 28 | import qualified Data.Functor.Sum as Functor 29 | import Data.List.NonEmpty (NonEmpty) 30 | import Data.Proxy (Proxy (..)) 31 | import Data.Ratio (Ratio) 32 | import qualified Data.Semigroup as Semigroup 33 | import qualified GHC.Generics as Generic 34 | 35 | -- | This property should be true for every `HasRep` instance. `r` should be a classifying object, 36 | -- and the first argument a comparison (e.g., `Bool` and `==` or `Hedgehog.Property` and 37 | -- `Hedgehog.===`) to make it easy to test. 38 | abstReturn :: forall a r. (HasRep a) => Proxy a -> (Rep a -> Rep a -> r) -> Rep a -> r 39 | abstReturn Proxy eq = eq <$> id <*> repr . abst @a 40 | 41 | -- | This property should be true for every `HasRep` instance. `r` should be a classifying object, 42 | -- and the first argument a comparison (e.g., `Bool` and `==` or `Hedgehog.Property` and 43 | -- `Hedgehog.===`) to make it easy to test. 44 | reprReturn :: (HasRep a) => (a -> a -> r) -> a -> r 45 | reprReturn eq = eq <$> id <*> abst . repr 46 | 47 | deriveHasRep ''[] 48 | deriveHasRep ''(,,) 49 | deriveHasRep ''(,,,) 50 | deriveHasRep ''(,,,,) 51 | deriveHasRep ''(,,,,,) 52 | deriveHasRep ''(,,,,,,) 53 | deriveHasRep ''(,,,,,,,) 54 | deriveHasRep ''(,,,,,,,,) 55 | deriveHasRep ''(,,,,,,,,,) 56 | deriveHasRep ''(,,,,,,,,,,) 57 | deriveHasRep ''(,,,,,,,,,,,) 58 | deriveHasRep ''(,,,,,,,,,,,,) 59 | deriveHasRep ''(,,,,,,,,,,,,,) 60 | deriveHasRep ''(,,,,,,,,,,,,,,) 61 | deriveHasRep ''(,,,,,,,,,,,,,,,) 62 | deriveHasRep ''(,,,,,,,,,,,,,,,,) 63 | deriveHasRep ''(,,,,,,,,,,,,,,,,,) 64 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,) 65 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,) 66 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,,) 67 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,,,) 68 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,,,,) 69 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,,,,,) 70 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,,,,,,) 71 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,,,,,,,) 72 | deriveHasRep ''(,,,,,,,,,,,,,,,,,,,,,,,,,,) 73 | deriveHasRep ''Complex 74 | deriveHasRep ''Compose 75 | deriveHasRep ''Functor.Product 76 | deriveHasRep ''Functor.Sum 77 | deriveHasRep ''(Generic.:+:) 78 | deriveHasRep ''(Generic.:*:) 79 | deriveHasRep ''(Generic.:.:) 80 | deriveHasRep ''Generic.K1 81 | deriveHasRep ''Generic.M1 82 | deriveHasRep ''Generic.Par1 83 | deriveHasRep ''Generic.U1 84 | deriveHasRep ''Identity 85 | deriveHasRep ''Maybe 86 | deriveHasRep ''NonEmpty 87 | deriveHasRep ''Ordering 88 | deriveHasRep ''Proxy 89 | deriveHasRep ''Ratio 90 | deriveHasRep ''Semigroup.All 91 | deriveHasRep ''Semigroup.Any 92 | deriveHasRep ''Semigroup.Dual 93 | deriveHasRep ''Semigroup.Endo 94 | deriveHasRep ''Semigroup.Max 95 | deriveHasRep ''Semigroup.Min 96 | deriveHasRep ''Semigroup.Product 97 | deriveHasRep ''Semigroup.Sum 98 | -------------------------------------------------------------------------------- /client/categorifier-client.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-client 4 | version: 0.1 5 | description: Client library for the categorifier plugin 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | , constraints ^>=0.12.0 || ^>=0.13.0 21 | default-language: Haskell2010 22 | default-extensions: 23 | BangPatterns 24 | DeriveDataTypeable 25 | DeriveFoldable 26 | DeriveFunctor 27 | DeriveGeneric 28 | DeriveTraversable 29 | DerivingStrategies 30 | FlexibleContexts 31 | FlexibleInstances 32 | FunctionalDependencies 33 | InstanceSigs 34 | LambdaCase 35 | ScopedTypeVariables 36 | StandaloneDeriving 37 | TypeApplications 38 | TypeOperators 39 | 40 | library 41 | import: defaults 42 | exposed-modules: 43 | Categorifier.Client 44 | other-modules: 45 | Categorifier.Client.Internal 46 | Paths_categorifier_client 47 | autogen-modules: 48 | Paths_categorifier_client 49 | build-depends: 50 | , PyF ^>=0.9.0 || ^>=0.10.0 || ^>=0.11.0 51 | , categorifier-common 52 | , categorifier-duoids 53 | , categorifier-th 54 | , extra ^>=1.7.8 55 | 56 | test-suite client-instances 57 | import: defaults 58 | type: exitcode-stdio-1.0 59 | hs-source-dirs: test 60 | main-is: Main.hs 61 | build-depends: 62 | , categorifier-client 63 | , categorifier-hedgehog 64 | , fin ^>=0.1.1 || ^>=0.2 || ^>=0.3 65 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 66 | -------------------------------------------------------------------------------- /common/categorifier-common.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-common 4 | version: 0.1 5 | description: Common library for the categorifier plugin 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Common.IO.Exception 43 | other-modules: 44 | Paths_categorifier_common 45 | autogen-modules: 46 | Paths_categorifier_common 47 | build-depends: 48 | , PyF ^>=0.9.0 || ^>=0.10.0 || ^>=0.11.0 49 | , unliftio ^>=0.2.13 50 | -------------------------------------------------------------------------------- /duoids/Categorifier/Duoidal/Either.hs: -------------------------------------------------------------------------------- 1 | -- | Operations specific to failure duoids. 2 | module Categorifier.Duoidal.Either 3 | ( noteAccum, 4 | ) 5 | where 6 | 7 | import Categorifier.Duoidal (Parallel (..)) 8 | import Data.List.NonEmpty (NonEmpty) 9 | 10 | -- | Converts a maybe-returning function into a failed-input-accumulating one. 11 | -- 12 | -- This is particularly useful for traversals, where you want to track _which_ elements of the 13 | -- traversal failed. E.g., 14 | -- 15 | -- > traverse safeHead :: t [a] -> Maybe (t a) 16 | -- 17 | -- becomes 18 | -- 19 | -- > traverse (noteAccum safeHead) :: t [a] -> Parallel (Either (NonEmpty a)) (t a) 20 | noteAccum :: (a -> Maybe b) -> a -> Parallel (Either (NonEmpty a)) b 21 | noteAccum f a = Parallel . maybe (Left $ pure a) pure $ f a 22 | -------------------------------------------------------------------------------- /duoids/categorifier-duoids.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-duoids 4 | version: 0.1 5 | description: Duoids 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Duoidal 43 | Categorifier.Duoidal.Either 44 | other-modules: 45 | Paths_categorifier_duoids 46 | autogen-modules: 47 | Paths_categorifier_duoids 48 | build-depends: 49 | , transformers ^>=0.5.6 || ^>=0.6.0 50 | -------------------------------------------------------------------------------- /garnix.yaml: -------------------------------------------------------------------------------- 1 | # This file was generated by Project Manager. 2 | {"builds":{"exclude":["*.x86_64-darwin","*.x86_64-darwin.*","devShells.aarch64-darwin.ghc928","homeConfigurations.x86_64-darwin-categorifier-example","devShells.*.ghc8107","packages.*.ghc8107_all","packages.*.ghc8107_categorifier-ghc-bignum-integration","packages.*.ghc8107_categorifier-ghc-bignum-integration-test","packages.*.ghc8107_categorifier-linear-base-integration","packages.*.ghc8107_categorifier-linear-base-integration-test","devShells.*.lax-checks"],"include":["*.*","*.*.*"]}} -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Builtin.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE PatternSynonyms #-} 3 | 4 | module Categorifier.GHC.Builtin 5 | ( module PrelNames, 6 | module PrimOp, 7 | module TysPrim, 8 | module TysWiredIn, 9 | module Unique, 10 | pattern DoubleToFloatOp, 11 | pattern FloatToDoubleOp, 12 | pattern IntToDoubleOp, 13 | pattern IntToFloatOp, 14 | pattern WordToDoubleOp, 15 | pattern WordToFloatOp, 16 | integerFromInt64Name, 17 | integerToDoubleName, 18 | integerToFloatName, 19 | ) 20 | where 21 | 22 | import qualified Categorifier.GHC.Types as Types 23 | #if MIN_VERSION_ghc(9, 0, 0) 24 | import GHC.Builtin.Names as PrelNames hiding 25 | ( integerFromInt64Name, 26 | integerToDoubleName, 27 | integerToFloatName, 28 | ) 29 | import qualified GHC.Builtin.Names as PrelNames 30 | import GHC.Builtin.Types as TysWiredIn 31 | import GHC.Builtin.Types.Prim as TysPrim 32 | #if MIN_VERSION_ghc(9, 2, 0) 33 | import GHC.Builtin.PrimOps as PrimOp hiding 34 | ( DoubleToFloatOp, 35 | FloatToDoubleOp, 36 | IntToDoubleOp, 37 | IntToFloatOp, 38 | WordToDoubleOp, 39 | WordToFloatOp, 40 | ) 41 | import qualified GHC.Builtin.PrimOps as PrimOp 42 | import GHC.Builtin.Uniques as Unique 43 | #else 44 | import GHC.Builtin.PrimOps as PrimOp 45 | import GHC.Types.Unique as Unique 46 | #endif 47 | #else 48 | import PrelNames 49 | import PrimOp 50 | import TysPrim 51 | import TysWiredIn 52 | import Unique 53 | #endif 54 | 55 | pattern DoubleToFloatOp :: PrimOp 56 | 57 | pattern FloatToDoubleOp :: PrimOp 58 | 59 | pattern IntToDoubleOp :: PrimOp 60 | 61 | pattern IntToFloatOp :: PrimOp 62 | 63 | pattern WordToDoubleOp :: PrimOp 64 | 65 | pattern WordToFloatOp :: PrimOp 66 | #if MIN_VERSION_ghc(9, 2, 0) 67 | pattern DoubleToFloatOp = PrimOp.DoubleToFloatOp 68 | pattern FloatToDoubleOp = PrimOp.FloatToDoubleOp 69 | pattern IntToDoubleOp = PrimOp.IntToDoubleOp 70 | pattern IntToFloatOp = PrimOp.IntToFloatOp 71 | pattern WordToDoubleOp = PrimOp.WordToDoubleOp 72 | pattern WordToFloatOp = PrimOp.WordToFloatOp 73 | #else 74 | pattern DoubleToFloatOp = Double2FloatOp 75 | pattern FloatToDoubleOp = Float2DoubleOp 76 | pattern IntToDoubleOp = Int2DoubleOp 77 | pattern IntToFloatOp = Int2FloatOp 78 | pattern WordToDoubleOp = Word2DoubleOp 79 | pattern WordToFloatOp = Word2FloatOp 80 | #endif 81 | 82 | integerFromInt64Name :: Types.Name 83 | #if MIN_VERSION_ghc(9, 0, 0) 84 | integerFromInt64Name = PrelNames.integerFromInt64Name 85 | #else 86 | integerFromInt64Name = smallIntegerName 87 | #endif 88 | 89 | integerToDoubleName :: Types.Name 90 | #if MIN_VERSION_ghc(9, 0, 0) 91 | integerToDoubleName = PrelNames.integerToDoubleName 92 | #else 93 | integerToDoubleName = doubleFromIntegerName 94 | #endif 95 | 96 | integerToFloatName :: Types.Name 97 | #if MIN_VERSION_ghc(9, 0, 0) 98 | integerToFloatName = PrelNames.integerToFloatName 99 | #else 100 | integerToFloatName = floatFromIntegerName 101 | #endif 102 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Data.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- -Wno-orphans is so we can add missing instances to `Bag.Bag` 3 | {-# OPTIONS_GHC -Wno-orphans #-} 4 | 5 | module Categorifier.GHC.Data 6 | ( module Bag, 7 | module FastString, 8 | module Pair, 9 | ) 10 | where 11 | 12 | #if MIN_VERSION_ghc(9, 0, 0) 13 | import GHC.Data.Bag as Bag 14 | import GHC.Data.FastString as FastString 15 | import GHC.Data.Pair as Pair 16 | #else 17 | import Bag 18 | import FastString 19 | import Pair 20 | #endif 21 | 22 | -- | Need this instance to use a `Bag.Bag` as the output of @RWST@. 23 | instance Semigroup (Bag.Bag a) where 24 | (<>) = Bag.unionBags 25 | 26 | -- | Need this instance to use a `Bag.Bag` as the output of @RWST@. 27 | instance Monoid (Bag.Bag a) where 28 | mempty = Bag.emptyBag 29 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Driver.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Categorifier.GHC.Driver 4 | ( module DynFlags, 5 | module HscTypes, 6 | module Outputable, 7 | module Plugins, 8 | ) 9 | where 10 | 11 | #if MIN_VERSION_ghc(9, 0, 0) 12 | #if MIN_VERSION_ghc(9, 2, 0) 13 | import GHC.Driver.Env.Types as HscTypes 14 | import GHC.Driver.Ppr as Outputable 15 | #else 16 | import GHC.Driver.Types as HscTypes hiding 17 | ( InteractiveContext (..), 18 | InteractiveImport (..), 19 | ModGuts (..), 20 | ) 21 | import GHC.Utils.Outputable as Outputable hiding (Outputable (..), renderWithStyle) 22 | #endif 23 | import GHC.Driver.Plugins as Plugins 24 | import GHC.Driver.Session as DynFlags 25 | #else 26 | import DynFlags 27 | import HscTypes hiding (InteractiveContext (..), InteractiveImport (..), ModGuts (..)) 28 | import Outputable hiding (Outputable (..), renderWithStyle) 29 | import Plugins 30 | #endif 31 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/HsToCore.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Categorifier.GHC.HsToCore 4 | ( module DsBinds, 5 | module DsMonad, 6 | ) 7 | where 8 | 9 | #if MIN_VERSION_ghc(9, 0, 0) 10 | import GHC.HsToCore.Binds as DsBinds 11 | import GHC.HsToCore.Monad as DsMonad 12 | #else 13 | import DsBinds 14 | import DsMonad 15 | #endif 16 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Plugins.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Categorifier.GHC.Plugins 4 | ( module Plugins, 5 | ) 6 | where 7 | 8 | #if MIN_VERSION_ghc(9, 0, 0) 9 | import GHC.Plugins as Plugins 10 | #else 11 | import GhcPlugins as Plugins 12 | #endif 13 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Runtime.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Categorifier.GHC.Runtime 4 | ( module DynamicLoading, 5 | module HscTypes, 6 | ) 7 | where 8 | 9 | #if MIN_VERSION_ghc(9, 0, 0) 10 | #if MIN_VERSION_ghc(9, 2, 0) 11 | import GHC.Runtime.Context as HscTypes 12 | #else 13 | import GHC.Driver.Types as HscTypes 14 | #endif 15 | import GHC.Runtime.Loader as DynamicLoading 16 | #else 17 | import DynamicLoading 18 | import HscTypes hiding (ModGuts (..)) 19 | #endif 20 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Tc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Categorifier.GHC.Tc 4 | ( module TcErrors, 5 | module TcEvidence, 6 | module TcHsSyn, 7 | module TcInteract, 8 | module TcRnDriver, 9 | module TcRnMonad, 10 | module TcRnTypes, 11 | module TcSMonad, 12 | module TcSimplify, 13 | module TcType, 14 | runTcInteractive, 15 | ) 16 | where 17 | 18 | import qualified Categorifier.GHC.Driver as Driver 19 | import qualified Categorifier.GHC.Types as Types 20 | #if MIN_VERSION_ghc(9, 2, 0) 21 | import Control.Arrow (Arrow (..)) 22 | #endif 23 | #if MIN_VERSION_ghc(9, 0, 0) 24 | import GHC.Tc.Errors as TcErrors 25 | import GHC.Tc.Module as TcRnDriver hiding (runTcInteractive) 26 | import qualified GHC.Tc.Module as TcRnDriver 27 | import GHC.Tc.Solver as TcSimplify 28 | import GHC.Tc.Solver.Interact as TcInteract 29 | import GHC.Tc.Solver.Monad as TcSMonad (TcS, runTcS) 30 | import GHC.Tc.Types as TcRnTypes 31 | import GHC.Tc.Types.Constraint as TcRnTypes 32 | import GHC.Tc.Types.Evidence as TcEvidence 33 | import GHC.Tc.Types.Origin as TcType 34 | import GHC.Tc.Utils.Monad as TcRnMonad 35 | import GHC.Tc.Utils.Zonk as TcHsSyn 36 | #else 37 | import Constraint as TcRnTypes 38 | import TcOrigin as TcType 39 | import TcErrors 40 | import TcEvidence 41 | import TcHsSyn 42 | import TcInteract 43 | import TcRnDriver hiding (runTcInteractive) 44 | import qualified TcRnDriver 45 | import TcRnMonad 46 | import TcSMonad (TcS, runTcS) 47 | import TcSimplify 48 | #endif 49 | 50 | runTcInteractive :: 51 | Driver.HscEnv -> TcRn a -> IO ((Types.ErrorMessages, Types.WarningMessages), Maybe a) 52 | #if MIN_VERSION_ghc(9, 2, 0) 53 | runTcInteractive env = 54 | fmap (first (Types.getErrorMessages &&& Types.getWarningMessages)) 55 | . TcRnDriver.runTcInteractive env 56 | #else 57 | runTcInteractive = TcRnDriver.runTcInteractive 58 | #endif 59 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE PatternSynonyms #-} 4 | {-# LANGUAGE QuasiQuotes #-} 5 | 6 | module Categorifier.GHC.Types 7 | ( module BasicTypes, 8 | module ErrUtils, 9 | module ForeignCall, 10 | module HscTypes, 11 | module Id, 12 | module IdInfo, 13 | module Literal, 14 | module Name, 15 | module RdrName, 16 | module SrcLoc, 17 | module UniqSet, 18 | module UniqSupply, 19 | module Unique, 20 | module Var, 21 | module VarEnv, 22 | module VarSet, 23 | pattern CCallSpec, 24 | pattern LitNumber, 25 | WithIdInfo (..), 26 | mkLocalVar, 27 | mkSysLocal, 28 | setLiteralType, 29 | stringToName, 30 | ) 31 | where 32 | 33 | import qualified Categorifier.GHC.Data as Data 34 | import qualified Categorifier.GHC.Unit as Unit 35 | import Categorifier.GHC.Utils ((<+>)) 36 | import qualified Categorifier.GHC.Utils as Utils 37 | #if MIN_VERSION_ghc(9, 0, 0) 38 | -- needed to avoid an import cycle 39 | import qualified GHC.Core.TyCo.Rep as Core 40 | import GHC.Types.Basic as BasicTypes hiding (Inline) 41 | import GHC.Types.ForeignCall as ForeignCall hiding (CCallSpec (..)) 42 | import qualified GHC.Types.ForeignCall as ForeignCall 43 | #if MIN_VERSION_ghc(9, 2, 0) 44 | import GHC.Types.Error as ErrUtils 45 | import GHC.Types.TyThing as HscTypes 46 | #else 47 | import GHC.Driver.Types as HscTypes hiding 48 | ( InteractiveContext (..), 49 | InteractiveImport (..), 50 | ModGuts (..), 51 | ) 52 | import GHC.Utils.Error as ErrUtils 53 | #endif 54 | import GHC.Types.Id as Id hiding (mkSysLocal) 55 | import qualified GHC.Types.Id as Id 56 | import GHC.Types.Id.Info as IdInfo 57 | import GHC.Types.Literal as Literal hiding (LitNumber) 58 | import qualified GHC.Types.Literal as Literal 59 | import GHC.Types.Name as Name hiding (varName) 60 | import GHC.Types.Name.Reader as RdrName 61 | import GHC.Types.SrcLoc as SrcLoc 62 | import GHC.Types.Unique as Unique 63 | import GHC.Types.Unique.Set as UniqSet 64 | import GHC.Types.Unique.Supply as UniqSupply 65 | import GHC.Types.Var as Var hiding (lazySetIdInfo, mkLocalVar, setIdExported, setIdNotExported) 66 | import qualified GHC.Types.Var as Var 67 | import GHC.Types.Var.Env as VarEnv 68 | import GHC.Types.Var.Set as VarSet 69 | #else 70 | import BasicTypes hiding (Inline) 71 | import qualified Categorifier.GHC.Driver as Driver 72 | import ErrUtils 73 | import HscTypes hiding (InteractiveContext (..), InteractiveImport (..), ModGuts (..)) 74 | import ForeignCall hiding (CCallSpec (..)) 75 | import qualified ForeignCall 76 | import Id hiding (mkSysLocal) 77 | import qualified Id 78 | import IdInfo 79 | import Literal hiding (LitNumber) 80 | import qualified Literal 81 | import Name hiding (varName) 82 | import RdrName 83 | import SrcLoc 84 | -- needed to avoid an import cycle 85 | import qualified TyCoRep as Core 86 | import UniqSet 87 | import UniqSupply 88 | import Unique 89 | import Var hiding (lazySetIdInfo, mkLocalVar, setIdExported, setIdNotExported) 90 | import qualified Var 91 | import VarEnv 92 | import VarSet 93 | #endif 94 | import PyF (fmt) 95 | 96 | pattern CCallSpec :: CCallTarget -> CCallConv -> Safety -> ForeignCall.CCallSpec 97 | #if MIN_VERSION_ghc(8, 10, 7) && !MIN_VERSION_ghc(9, 0, 0) 98 | pattern CCallSpec target conv safety <- ForeignCall.CCallSpec target conv safety _ _ 99 | #else 100 | pattern CCallSpec target conv safety = ForeignCall.CCallSpec target conv safety 101 | #endif 102 | 103 | pattern LitNumber :: Integer -> Literal 104 | #if MIN_VERSION_ghc(9, 0, 0) 105 | pattern LitNumber n <- Literal.LitNumber _ n 106 | #else 107 | pattern LitNumber n <- Literal.LitNumber _ n _ 108 | #endif 109 | 110 | mkLocalVar :: IdDetails -> Name -> Core.Type -> IdInfo -> Id 111 | #if MIN_VERSION_ghc(9, 0, 0) 112 | mkLocalVar details name ty = Var.mkLocalVar details name ty ty 113 | #else 114 | mkLocalVar = Var.mkLocalVar 115 | #endif 116 | 117 | mkSysLocal :: Data.FastString -> Unique -> Core.Type -> Id 118 | #if MIN_VERSION_ghc(9, 0, 0) 119 | mkSysLocal fs uniq ty = Id.mkSysLocal fs uniq ty ty 120 | #else 121 | mkSysLocal = Id.mkSysLocal 122 | #endif 123 | 124 | setLiteralType :: Core.Type -> Literal -> Literal 125 | #if MIN_VERSION_ghc(9, 0, 0) 126 | #else 127 | setLiteralType toType (Literal.LitNumber litNumTy litNumVal _oldType) = 128 | Literal.LitNumber litNumTy litNumVal toType 129 | #endif 130 | setLiteralType _ x = x 131 | 132 | stringToName :: String -> Name 133 | stringToName str = 134 | mkSystemVarName 135 | -- When mkUniqueGrimily's argument is negative, we see something like 136 | -- "Exception: Prelude.chr: bad argument: (-52)". Hence the abs. 137 | (mkUniqueGrimily (abs (fromIntegral (Utils.hashString str)))) 138 | (Data.mkFastString str) 139 | 140 | newtype WithIdInfo = WithIdInfo Id 141 | 142 | #if MIN_VERSION_ghc(9, 0, 0) 143 | instance Utils.Outputable WithIdInfo where 144 | -- I wanted the full IdInfo, but it's not `Utils.Outputable` 145 | ppr (WithIdInfo v) = 146 | Utils.sdocWithContext $ \ctx -> 147 | let ident = 148 | ( if Utils.sdocSuppressModulePrefixes ctx 149 | then id 150 | else 151 | ( maybe 152 | "" 153 | (\m -> [fmt|{Unit.moduleNameString $ Unit.moduleName m}.|]) 154 | (nameModule_maybe $ varName v) 155 | Utils.<> 156 | ) 157 | ) 158 | $ Utils.ppr v 159 | in if Utils.sdocSuppressTypeSignatures ctx 160 | then ident 161 | else 162 | Utils.sep 163 | [ident, Utils.nest 2 $ Utils.dcolon <+> Utils.ppr (varType v)] 164 | #else 165 | instance Utils.Outputable WithIdInfo where 166 | -- I wanted the full IdInfo, but it's not `Utils.Outputable` 167 | ppr (WithIdInfo v) = 168 | Utils.sdocWithDynFlags $ \dflags -> 169 | let ident = 170 | ( if Driver.gopt Driver.Opt_SuppressModulePrefixes dflags 171 | then id 172 | else 173 | ( maybe 174 | "" 175 | (\m -> [fmt|{Unit.moduleNameString $ Unit.moduleName m}.|]) 176 | (nameModule_maybe $ varName v) 177 | Utils.<> 178 | ) 179 | ) 180 | $ Utils.ppr v 181 | in if Driver.gopt Driver.Opt_SuppressTypeSignatures dflags 182 | then ident 183 | else 184 | Utils.sep 185 | [ident, Utils.nest 2 $ Utils.dcolon <+> Utils.ppr (varType v)] 186 | #endif 187 | 188 | instance Utils.OutputableBndr WithIdInfo where 189 | pprInfixOcc = Utils.ppr 190 | pprPrefixOcc = Utils.ppr 191 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Unit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Categorifier.GHC.Unit 4 | ( module Finder, 5 | module HscTypes, 6 | module Module, 7 | ) 8 | where 9 | 10 | #if MIN_VERSION_ghc(9, 0, 0) 11 | #if MIN_VERSION_ghc(9, 2, 0) 12 | import GHC.Unit.Finder as Finder 13 | import GHC.Unit.Module.Deps as Module 14 | import GHC.Unit.Module.ModGuts as HscTypes 15 | #else 16 | import GHC.Driver.Finder as Finder 17 | import GHC.Driver.Types as HscTypes (ModGuts (..)) 18 | #endif 19 | import GHC.Unit.Module.Name as Module 20 | import GHC.Unit.Types as Module 21 | #else 22 | import Finder 23 | import HscTypes (ModGuts (..)) 24 | import Module 25 | #endif 26 | -------------------------------------------------------------------------------- /ghc/Categorifier/GHC/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | 4 | module Categorifier.GHC.Utils 5 | ( module ErrUtils, 6 | module Outputable, 7 | module Panic, 8 | module Util, 9 | HasLogger, 10 | Logger, 11 | getLogger, 12 | pprMsgEnvelopeBagWithLoc, 13 | renderWithStyle, 14 | ) 15 | where 16 | 17 | import qualified Categorifier.GHC.Data as Data 18 | import qualified Categorifier.GHC.Driver as Driver 19 | #if MIN_VERSION_ghc(9, 2, 0) 20 | import qualified GHC.Utils.Logger as Logger 21 | #endif 22 | #if MIN_VERSION_ghc(9, 0, 0) 23 | #if MIN_VERSION_ghc(9, 2, 0) 24 | import GHC.Utils.Error as ErrUtils hiding (pprMsgEnvelopeBagWithLoc) 25 | import qualified GHC.Utils.Error as ErrUtils 26 | import GHC.Utils.Outputable as Outputable 27 | #else 28 | import GHC.Utils.Error as ErrUtils 29 | import GHC.Utils.Outputable as Outputable hiding (renderWithStyle) 30 | import qualified GHC.Utils.Outputable as Outputable 31 | #endif 32 | import GHC.Utils.Misc as Util 33 | import GHC.Utils.Panic as Panic 34 | #else 35 | import ErrUtils 36 | import Outputable hiding (renderWithStyle) 37 | import qualified Outputable 38 | import Panic 39 | import Util 40 | #endif 41 | 42 | #if MIN_VERSION_ghc(9, 2, 0) 43 | type HasLogger = Logger.HasLogger 44 | #else 45 | type HasLogger = Applicative 46 | #endif 47 | 48 | #if MIN_VERSION_ghc(9, 2, 0) 49 | type Logger = Logger.Logger 50 | #else 51 | type Logger = () 52 | #endif 53 | 54 | getLogger :: (HasLogger m) => m Logger 55 | #if MIN_VERSION_ghc(9, 2, 0) 56 | getLogger = Logger.getLogger 57 | #else 58 | getLogger = pure () 59 | #endif 60 | 61 | #if MIN_VERSION_ghc(9, 2, 0) 62 | pprMsgEnvelopeBagWithLoc :: Data.Bag (MsgEnvelope DecoratedSDoc) -> [Outputable.SDoc] 63 | pprMsgEnvelopeBagWithLoc = ErrUtils.pprMsgEnvelopeBagWithLoc 64 | #else 65 | pprMsgEnvelopeBagWithLoc :: Data.Bag ErrMsg -> [Outputable.SDoc] 66 | pprMsgEnvelopeBagWithLoc = pprErrMsgBagWithLoc 67 | #endif 68 | 69 | renderWithStyle :: Driver.DynFlags -> PrintUnqualified -> SDoc -> String 70 | #if MIN_VERSION_ghc(9, 2, 0) 71 | renderWithStyle dflags = renderWithContext . Driver.initSDocContext dflags . mkDumpStyle 72 | #elif MIN_VERSION_ghc(9, 0, 0) 73 | renderWithStyle dflags = Outputable.renderWithStyle . Driver.initSDocContext dflags . mkDumpStyle 74 | #else 75 | renderWithStyle dflags qual sdoc = Outputable.renderWithStyle dflags sdoc (mkDumpStyle dflags qual) 76 | #endif 77 | -------------------------------------------------------------------------------- /ghc/categorifier-ghc.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-ghc 4 | version: 0.1 5 | description: GHC-as-a-library conditionalization for Categorifier 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.GHC.Builtin 43 | Categorifier.GHC.Core 44 | Categorifier.GHC.Data 45 | Categorifier.GHC.Driver 46 | Categorifier.GHC.HsToCore 47 | Categorifier.GHC.Plugins 48 | Categorifier.GHC.Runtime 49 | Categorifier.GHC.Tc 50 | Categorifier.GHC.Types 51 | Categorifier.GHC.Unit 52 | Categorifier.GHC.Utils 53 | Paths_categorifier_ghc 54 | autogen-modules: 55 | Paths_categorifier_ghc 56 | ghc-options: 57 | -O2 58 | -fignore-interface-pragmas 59 | build-depends: 60 | , PyF ^>=0.9.0 || ^>=0.10.0 || ^>=0.11.0 61 | , bytestring ^>=0.10.9 || ^>=0.11.0 62 | , containers ^>=0.6.2 63 | , ghc ^>=8.8.1 || ^>=8.10.1 || ^>=9.0.1 || ^>=9.2.1 64 | -------------------------------------------------------------------------------- /hedgehog/Categorifier/Hedgehog.hs: -------------------------------------------------------------------------------- 1 | -- | Some useful functions for testing with "Hedgehog". 2 | module Categorifier.Hedgehog 3 | ( floatingEq, 4 | genFloating, 5 | genInteger, 6 | genIntegralBounded, 7 | genNatural, 8 | genNaturalFrom, 9 | ) 10 | where 11 | 12 | import qualified GHC.Float 13 | import GHC.Stack (HasCallStack, withFrozenCallStack) 14 | import qualified Hedgehog 15 | import qualified Hedgehog.Gen as Gen 16 | import qualified Hedgehog.Range as Range 17 | import Numeric.Natural (Natural) 18 | 19 | -- | A variant on `Hedgehog.===` that identifies NaNs as equals. It still works for non-FP types. 20 | floatingEq :: (Hedgehog.MonadTest m, Eq a, Show a, HasCallStack) => a -> a -> m () 21 | floatingEq x y = withFrozenCallStack $ Hedgehog.diff x eq y 22 | where 23 | eq x' y' = x' /= x' && y' /= y' || x' == y' 24 | 25 | -- | Generate any 'GHC.Float.RealFloat' value. 26 | -- 27 | -- This generator chooses a value from 28 | -- 29 | -- * small ranges around starting points that often cause problems: 30 | -- 31 | -- * 0 32 | -- * 1 33 | -- * @pi / 2@ 34 | -- * @pi@ 35 | -- 36 | -- * a general range spanning all numerical values 37 | -- 38 | -- * special IEEE values like infinities and @NaN@. 39 | genFloating :: forall a m. (Hedgehog.MonadGen m, GHC.Float.RealFloat a) => m a 40 | genFloating = 41 | Gen.choice 42 | . fmap Gen.realFloat 43 | $ 44 | -- Search around 0, and don't forget -0.0, as well as 1, pi/2 and 45 | -- pi, as these are often sensitive values for algorithms and 46 | -- functions. 47 | aroundPosNeg 0 1e-6 48 | <> aroundPosNeg 1 1e-6 49 | <> aroundPosNeg (pi / 2) 1e-6 50 | <> aroundPosNeg pi 1e-6 51 | <> 52 | -- This limit exceeds the max value of doubles, +-1e308 53 | [ Range.exponentialFloatFrom 0 (-1e322) 1e322, 54 | Range.singleton $ 1 / 0, -- Infinity 55 | Range.singleton $ (-1) / 0, -- -Infinity 56 | Range.singleton $ 0 / 0 -- NaN 57 | ] 58 | where 59 | aroundFloat :: a -> a -> Range.Range a 60 | aroundFloat float size = Range.exponentialFloatFrom float (float - size) (float + size) 61 | aroundPosNeg :: a -> a -> [Range.Range a] 62 | aroundPosNeg float size = [aroundFloat float size, aroundFloat (negate float) size] 63 | 64 | -- | Generate an arbitrary, potentially quite large, integer. 65 | genInteger :: (Hedgehog.MonadGen m) => m Integer 66 | genInteger = Gen.integral $ Range.linearFrom 0 (-maxUnbounded) maxUnbounded 67 | 68 | -- | Like `Gen.enumBounded`, but safe for integral types larger than `Int` 69 | -- (which can vary based on the platform). 70 | genIntegralBounded :: (Hedgehog.MonadGen m, Bounded a, Integral a) => m a 71 | genIntegralBounded = Gen.integral Range.linearBounded 72 | 73 | -- | Arbitrary large value for bounding unbounded integral types. 74 | maxUnbounded :: (Integral a) => a 75 | maxUnbounded = 10 ^ (100 :: Natural) 76 | 77 | -- | Like `genNatural`, but takes a lower bound. This is useful for eliminating invalid cases for 78 | -- things like subtraction. 79 | genNaturalFrom :: (Hedgehog.MonadGen m) => Natural -> m Natural 80 | genNaturalFrom lowerBound = Gen.integral $ Range.linear lowerBound maxUnbounded 81 | 82 | -- | Generate an arbitrary, potentially quite large, non-negative number. 83 | genNatural :: (Hedgehog.MonadGen m) => m Natural 84 | genNatural = genNaturalFrom 0 85 | -------------------------------------------------------------------------------- /hedgehog/categorifier-hedgehog.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-hedgehog 4 | version: 0.1 5 | description: Additional functions to assist testing with Hedgehog. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Hedgehog 43 | other-modules: 44 | Paths_categorifier_hedgehog 45 | autogen-modules: 46 | Paths_categorifier_hedgehog 47 | build-depends: 48 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 49 | -------------------------------------------------------------------------------- /integrations/adjunctions/integration-test/Categorifier/Test/Adjunctions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | -- To avoid having to specify massive HList types. 3 | {-# LANGUAGE PartialTypeSignatures #-} 4 | {-# LANGUAGE PolyKinds #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | -- To avoid having to specify massive HList types. 7 | {-# OPTIONS_GHC -Wno-partial-type-signatures #-} 8 | 9 | module Categorifier.Test.Adjunctions 10 | ( testTerms, 11 | ) 12 | where 13 | 14 | import Categorifier.Test.HList (HMap1 (..)) 15 | import Categorifier.Test.TH (mkBinaryTestConfig, mkUnaryTestConfig) 16 | import Categorifier.Test.Tests (TestTerms, insertTest) 17 | import Data.Functor.Identity (Identity (..)) 18 | import qualified Data.Functor.Rep as Representable 19 | import Data.Proxy (Proxy (..)) 20 | 21 | testTerms :: TestTerms _ 22 | testTerms = 23 | insertTest 24 | (Proxy @"PureRep") 25 | mkUnaryTestConfig 26 | (\a -> (a, [t|Identity $a|])) 27 | [|Representable.pureRep|] 28 | . insertTest 29 | (Proxy @"FmapRep") 30 | mkUnaryTestConfig 31 | (\a -> ([t|Identity $a|], [t|Identity $a|])) 32 | [|Representable.fmapRep id|] 33 | . insertTest 34 | (Proxy @"ApRep") 35 | mkUnaryTestConfig 36 | (\a -> ([t|Identity $a|], [t|Identity $a|])) 37 | [|Representable.apRep (Identity id)|] 38 | . insertTest 39 | (Proxy @"BindRep") 40 | mkBinaryTestConfig 41 | (\a -> ([t|Identity $a|], [t|($a -> Identity $a) -> Identity $a|])) 42 | [|Representable.bindRep|] 43 | . insertTest 44 | (Proxy @"Index") 45 | mkBinaryTestConfig 46 | (\(f, a) -> ([t|$f $a|], [t|Representable.Rep $f -> $a|])) 47 | [|Representable.index|] 48 | . insertTest 49 | (Proxy @"Tabulate") 50 | mkUnaryTestConfig 51 | (\(f, a) -> ([t|Representable.Rep $f -> $a|], [t|$f $a|])) 52 | [|Representable.tabulate|] 53 | $ HEmpty1 54 | -------------------------------------------------------------------------------- /integrations/adjunctions/integration-test/categorifier-adjunctions-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-adjunctions-integration-test 4 | version: 0.1 5 | description: Test utilities for categorifier's adjunctions integration. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , adjunctions ^>=4.4 20 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 21 | , categorifier-plugin-test 22 | default-language: Haskell2010 23 | default-extensions: 24 | BangPatterns 25 | DeriveDataTypeable 26 | DeriveFoldable 27 | DeriveFunctor 28 | DeriveGeneric 29 | DeriveTraversable 30 | DerivingStrategies 31 | FlexibleContexts 32 | FlexibleInstances 33 | FunctionalDependencies 34 | InstanceSigs 35 | LambdaCase 36 | ScopedTypeVariables 37 | StandaloneDeriving 38 | TypeApplications 39 | TypeOperators 40 | 41 | library 42 | import: defaults 43 | exposed-modules: 44 | Categorifier.Test.Adjunctions 45 | 46 | common hierarchy-tests 47 | import: defaults 48 | hs-source-dirs: test 49 | ghc-options: 50 | -- make it possible to inline almost anything 51 | -fexpose-all-unfoldings 52 | -- ensure unfoldings are available 53 | -fno-omit-interface-pragmas 54 | -fplugin Categorifier 55 | -fplugin-opt Categorifier:defer-failures 56 | -fplugin-opt Categorifier:hierarchy:Categorifier.Adjunctions.Integration.hierarchy 57 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.baseHierarchy 58 | -- need `curry` for some tests, so we add the categories hierarchy 59 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.Categories.hierarchy 60 | -fplugin-opt Categorifier:maker-map:Categorifier.Adjunctions.Integration.makerMapFun 61 | -fplugin-opt Categorifier:maker-map:Categorifier.Core.MakerMap.baseMakerMapFun 62 | build-depends: 63 | , categories ^>=1.0.7 64 | , categorifier-adjunctions-integration 65 | , categorifier-adjunctions-integration-test 66 | , categorifier-categories-integration 67 | , categorifier-categories-integration-test 68 | , categorifier-category 69 | , categorifier-client 70 | , categorifier-hedgehog 71 | , categorifier-plugin 72 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 73 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 74 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 75 | 76 | test-suite adjunctions-hierarchy 77 | import: hierarchy-tests 78 | type: exitcode-stdio-1.0 79 | main-is: Adjunctions/Main.hs 80 | ghc-options: 81 | -O0 82 | 83 | test-suite adjunctions-hierarchy-optimized 84 | import: hierarchy-tests 85 | type: exitcode-stdio-1.0 86 | main-is: Adjunctions/Main.hs 87 | ghc-options: 88 | -O2 89 | -fignore-interface-pragmas 90 | -------------------------------------------------------------------------------- /integrations/adjunctions/integration-test/test/Adjunctions/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE MultiWayIf #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE TupleSections #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | -- To avoid turning @if then else@ into `ifThenElse`. 8 | {-# LANGUAGE NoRebindableSyntax #-} 9 | 10 | -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. 11 | module Main 12 | ( main, 13 | ) 14 | where 15 | 16 | import Categorifier.Hedgehog (genFloating, genIntegralBounded) 17 | import qualified Categorifier.Test.Adjunctions as Adjunctions 18 | import Categorifier.Test.Categories.Instances (Hask (..), Term) 19 | import Categorifier.Test.Data (One (..)) 20 | import Categorifier.Test.HList (HMap1 (..)) 21 | import Categorifier.Test.Tests 22 | ( TestCases (..), 23 | TestCategory (..), 24 | TestStrategy (..), 25 | mkTestTerms, 26 | ) 27 | import Data.Bool (bool) 28 | import Data.Functor.Identity (Identity (..)) 29 | import Data.Proxy (Proxy (..)) 30 | import GHC.Int (Int64) 31 | import GHC.Word (Word8) 32 | import System.Exit (exitFailure, exitSuccess) 33 | 34 | -- For @NoRebindableSyntax@ 35 | {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} 36 | 37 | mkTestTerms 38 | Adjunctions.testTerms 39 | -- name type prefix strategy 40 | [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, 41 | TestCategory ''(->) [t|(->)|] "plainArrow" $ ComputeFromInput [|id|], 42 | TestCategory ''Hask [t|Hask|] "hask" (ComputeFromInput [|runHask|]) 43 | ] 44 | -- adjunctions 45 | . HInsert1 (Proxy @"PureRep") (TestCases (const [([t|Double|], pure ([|genFloating|], [|show|]))])) 46 | . HInsert1 (Proxy @"FmapRep") (TestCases (const [])) 47 | . HInsert1 (Proxy @"ApRep") (TestCases (const [([t|Int64|], pure ([|genIntegralBounded|], [|show|]))])) 48 | . HInsert1 49 | (Proxy @"BindRep") 50 | ( TestCases 51 | ( const 52 | [ ( [t|Word8|], 53 | pure ([|(,pure) . Identity <$> genIntegralBounded|], [|show . fst|]) 54 | ) 55 | ] 56 | ) 57 | ) 58 | . HInsert1 59 | (Proxy @"Index") 60 | ( TestCases 61 | ( const 62 | [ ( ([t|Identity|], [t|Word8|]), 63 | pure ([|(,) <$> genIntegralBounded <*> pure ()|], [|show|]) 64 | ), 65 | ( ([t|One|], [t|Word8|]), 66 | pure ([|(,) <$> (One <$> genIntegralBounded) <*> pure ()|], [|show|]) 67 | ) 68 | ] 69 | ) 70 | ) 71 | . HInsert1 72 | (Proxy @"Tabulate") 73 | ( TestCases 74 | ( const 75 | [ ( ([t|Identity|], [t|Word8|]), 76 | pure ([|const <$> genIntegralBounded|], [|("\\() -> " <>) . show . ($ ())|]) 77 | ), 78 | ( ([t|One|], [t|Word8|]), 79 | pure ([|const <$> genIntegralBounded|], [|("\\() -> " <>) . show . ($ ())|]) 80 | ) 81 | ] 82 | ) 83 | ) 84 | $ HEmpty1 85 | 86 | main :: IO () 87 | main = bool exitFailure exitSuccess . and =<< allTestTerms 88 | -------------------------------------------------------------------------------- /integrations/adjunctions/integration/Categorifier/Adjunctions/Integration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ApplicativeDo #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE PatternSynonyms #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE StrictData #-} 6 | {-# LANGUAGE TemplateHaskellQuotes #-} 7 | {-# LANGUAGE TupleSections #-} 8 | {-# LANGUAGE ViewPatterns #-} 9 | 10 | module Categorifier.Adjunctions.Integration 11 | ( hierarchy, 12 | makerMapFun, 13 | ) 14 | where 15 | 16 | import Categorifier.Core.MakerMap (MakerMapFun, baseMakerMapFun, makeMaker1) 17 | import Categorifier.Core.Makers (Makers (..)) 18 | import Categorifier.Core.Types (CategoryStack, Lookup) 19 | import Categorifier.Duoidal ((=<\<)) 20 | import qualified Categorifier.GHC.Core as Plugins 21 | import Categorifier.Hierarchy 22 | ( Hierarchy (..), 23 | emptyHierarchy, 24 | findTyCon, 25 | identifier, 26 | mkMethodApps, 27 | ) 28 | import qualified Control.Arrow 29 | import qualified Data.Functor.Rep 30 | import qualified Data.Map as Map 31 | import qualified GHC.Base 32 | 33 | hierarchy :: Lookup (Hierarchy CategoryStack) 34 | hierarchy = do 35 | kindexV <- 36 | pure <$> do 37 | arr <- identifier 'Control.Arrow.arr 38 | op <- identifier 'Data.Functor.Rep.index 39 | rep <- findTyCon ''Data.Functor.Rep.Rep 40 | pure $ \onDict cat f a -> do 41 | let repfTy = Plugins.mkTyConApp rep [f] 42 | op' <- mkMethodApps onDict op [f] [a] [] 43 | mkMethodApps onDict arr [cat] [Plugins.mkAppTy f a, Plugins.funTy repfTy a] [op'] 44 | ktabulateV <- 45 | pure <$> do 46 | arr <- identifier 'Control.Arrow.arr 47 | op <- identifier 'Data.Functor.Rep.tabulate 48 | rep <- findTyCon ''Data.Functor.Rep.Rep 49 | pure $ \onDict cat f a -> do 50 | let repfTy = Plugins.mkTyConApp rep [f] 51 | op' <- mkMethodApps onDict op [f] [a] [] 52 | mkMethodApps onDict arr [cat] [Plugins.funTy repfTy a, Plugins.mkAppTy f a] [op'] 53 | pure emptyHierarchy {indexV = kindexV, tabulateV = ktabulateV} 54 | 55 | makerMapFun :: MakerMapFun 56 | makerMapFun 57 | symbolLookup 58 | dflags 59 | logger 60 | m@Makers {..} 61 | n 62 | target 63 | expr 64 | cat 65 | var 66 | args 67 | modu 68 | categorifyFun 69 | categorifyLambda = 70 | Map.fromListWith 71 | const 72 | [ ( 'Data.Functor.Rep.apRep, 73 | \case 74 | f : a : b : representable : rest -> 75 | ($ (f : representable : a : b : rest)) =<< Map.lookup '(GHC.Base.<*>) baseMakerMap 76 | _ -> Nothing 77 | ), 78 | ( 'Data.Functor.Rep.bindRep, 79 | \case 80 | f : a : b : representable : rest -> 81 | ($ (f : representable : a : b : rest)) =<< Map.lookup '(GHC.Base.>>=) baseMakerMap 82 | _ -> Nothing 83 | ), 84 | ( 'Data.Functor.Rep.fmapRep, 85 | \case 86 | f : a : b : representable : rest -> 87 | ($ (f : representable : a : b : rest)) =<< Map.lookup 'GHC.Base.fmap baseMakerMap 88 | _ -> Nothing 89 | ), 90 | ( 'Data.Functor.Rep.index, 91 | \case 92 | Plugins.Type f : _representable : Plugins.Type a : rest -> 93 | pure $ maker1 rest =<\< mkIndex f a 94 | _ -> Nothing 95 | ), 96 | ( 'Data.Functor.Rep.liftR2, 97 | \case 98 | f : a : b : c : representable : rest -> 99 | ($ (f : representable : a : b : c : rest)) 100 | =<< Map.lookup 'GHC.Base.liftA2 baseMakerMap 101 | _ -> Nothing 102 | ), 103 | ( 'Data.Functor.Rep.pureRep, 104 | \case 105 | f : a : representable : rest -> 106 | ($ (f : representable : a : rest)) =<< Map.lookup 'GHC.Base.pure baseMakerMap 107 | _ -> Nothing 108 | ), 109 | ( 'Data.Functor.Rep.tabulate, 110 | \case 111 | Plugins.Type f : _representable : Plugins.Type a : rest -> 112 | pure $ maker1 rest =<\< mkTabulate f a 113 | _ -> Nothing 114 | ) 115 | ] 116 | where 117 | baseMakerMap = 118 | baseMakerMapFun 119 | symbolLookup 120 | dflags 121 | logger 122 | m 123 | n 124 | target 125 | expr 126 | cat 127 | var 128 | args 129 | modu 130 | categorifyFun 131 | categorifyLambda 132 | maker1 = makeMaker1 m categorifyLambda 133 | -------------------------------------------------------------------------------- /integrations/adjunctions/integration/categorifier-adjunctions-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-adjunctions-integration 4 | version: 0.1 5 | description: Extensions to Conal's ConCat to improve plugin coverage. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Adjunctions.Integration 43 | other-modules: 44 | Paths_categorifier_adjunctions_integration 45 | autogen-modules: 46 | Paths_categorifier_adjunctions_integration 47 | build-depends: 48 | , adjunctions ^>=4.4 49 | , categorifier-duoids 50 | , categorifier-ghc 51 | , categorifier-plugin 52 | , containers ^>=0.6.2 53 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 54 | , transformers ^>=0.5.6 || ^>=0.6.0 55 | -------------------------------------------------------------------------------- /integrations/categories/integration-test/Categorifier/Test/Categories/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE UndecidableInstances #-} 3 | {-# OPTIONS_GHC -Wno-orphans #-} 4 | 5 | module Categorifier.Test.Categories.Instances (Hask (..), Term (..)) where 6 | 7 | import Categorifier.Test.Data (Pair) 8 | import Categorifier.Test.Hask (Hask (..)) 9 | import Categorifier.Test.Term (Term (..), binaryZero, unaryZero) 10 | import qualified Control.Categorical.Bifunctor as Categories 11 | import qualified Control.Categorical.Functor as Categories 12 | import qualified Control.Category.Associative as Categories 13 | import qualified Control.Category.Braided as Categories 14 | import qualified Control.Category.Cartesian as Categories 15 | import qualified Control.Category.Cartesian.Closed as Categories 16 | import qualified Control.Category.Distributive as Categories 17 | import qualified Control.Category.Monoidal as Categories 18 | 19 | -- data 20 | 21 | instance Categories.Functor Pair (->) (->) where 22 | fmap = fmap -- the rhs is from base. 23 | 24 | -- Term 25 | 26 | instance Categories.Functor f Term Term where 27 | fmap = unaryZero 28 | 29 | instance Categories.PFunctor f Term Term where 30 | first = unaryZero 31 | 32 | instance Categories.QFunctor f Term Term where 33 | second = unaryZero 34 | 35 | instance Categories.Bifunctor t Term Term Term where 36 | bimap = binaryZero 37 | 38 | instance Categories.Associative Term t where 39 | associate = ZeroId 40 | disassociate = ZeroId 41 | 42 | instance Categories.Monoidal Term t where 43 | type Id Term t = () 44 | idl = ZeroId 45 | idr = ZeroId 46 | coidl = ZeroId 47 | coidr = ZeroId 48 | 49 | instance Categories.Braided Term t where 50 | braid = ZeroId 51 | 52 | instance Categories.Symmetric Term t 53 | 54 | instance Categories.Cartesian Term where 55 | type Product Term = (,) 56 | fst = ZeroId 57 | snd = ZeroId 58 | diag = ZeroId 59 | 60 | instance Categories.CoCartesian Term where 61 | type Sum Term = Either 62 | inl = ZeroId 63 | inr = ZeroId 64 | codiag = ZeroId 65 | 66 | instance Categories.CCC Term where 67 | type Exp Term = (->) 68 | apply = ZeroId 69 | curry = unaryZero 70 | uncurry = unaryZero 71 | 72 | instance Categories.Distributive Term where 73 | distribute = ZeroId 74 | 75 | -- Hask 76 | 77 | instance (Categories.Functor f (->) (->)) => Categories.Functor f Hask Hask where 78 | fmap (Hask f) = Hask (Categories.fmap f) 79 | 80 | instance (Categories.PFunctor f (->) (->)) => Categories.PFunctor f Hask Hask where 81 | first (Hask f) = Hask (Categories.first f) 82 | 83 | instance (Categories.QFunctor f (->) (->)) => Categories.QFunctor f Hask Hask where 84 | second (Hask g) = Hask (Categories.second g) 85 | 86 | instance (Categories.Bifunctor t (->) (->) (->)) => Categories.Bifunctor t Hask Hask Hask where 87 | bimap (Hask f) (Hask g) = Hask (Categories.bimap f g) 88 | 89 | instance (Categories.Associative (->) t) => Categories.Associative Hask t where 90 | associate = Hask Categories.associate 91 | disassociate = Hask Categories.disassociate 92 | 93 | instance (Categories.Monoidal (->) t) => Categories.Monoidal Hask t where 94 | type Id Hask t = Categories.Id (->) t 95 | idl = Hask Categories.idl 96 | idr = Hask Categories.idr 97 | coidl = Hask Categories.coidl 98 | coidr = Hask Categories.coidr 99 | 100 | instance (Categories.Braided (->) t) => Categories.Braided Hask t where 101 | braid = Hask Categories.braid 102 | 103 | instance (Categories.Symmetric (->) t) => Categories.Symmetric Hask t 104 | 105 | instance Categories.Cartesian Hask where 106 | type Product Hask = (,) 107 | fst = Hask Categories.fst 108 | snd = Hask Categories.snd 109 | diag = Hask Categories.diag 110 | 111 | instance Categories.CoCartesian Hask where 112 | type Sum Hask = Either 113 | inl = Hask Categories.inl 114 | inr = Hask Categories.inr 115 | codiag = Hask Categories.codiag 116 | 117 | instance Categories.CCC Hask where 118 | type Exp Hask = (->) 119 | apply = Hask Categories.apply 120 | curry (Hask f) = Hask (Categories.curry f) 121 | uncurry (Hask f) = Hask (Categories.uncurry f) 122 | 123 | instance Categories.Distributive Hask where 124 | distribute = Hask Categories.distribute 125 | -------------------------------------------------------------------------------- /integrations/categories/integration-test/categorifier-categories-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-categories-integration-test 4 | version: 0.1 5 | description: Plugin using Kmett's Categories classes. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | , categories ^>=1.0.7 21 | , categorifier-plugin-test 22 | default-language: Haskell2010 23 | default-extensions: 24 | BangPatterns 25 | DeriveDataTypeable 26 | DeriveFoldable 27 | DeriveFunctor 28 | DeriveGeneric 29 | DeriveTraversable 30 | DerivingStrategies 31 | FlexibleContexts 32 | FlexibleInstances 33 | FunctionalDependencies 34 | InstanceSigs 35 | LambdaCase 36 | ScopedTypeVariables 37 | StandaloneDeriving 38 | TypeApplications 39 | TypeOperators 40 | 41 | library 42 | import: defaults 43 | exposed-modules: 44 | Categorifier.Test.Categories.Instances 45 | 46 | common hierarchy-tests 47 | import: defaults 48 | hs-source-dirs: test 49 | ghc-options: 50 | -fplugin Categorifier 51 | -- -fplugin-opt Categorifier:defer-failures 52 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.Categories.hierarchy 53 | build-depends: 54 | , adjunctions ^>=4.4 55 | , categories ^>=1.0.7 56 | , categorifier-categories-integration 57 | , categorifier-categories-integration-test 58 | , categorifier-category 59 | , categorifier-client 60 | , categorifier-hedgehog 61 | , categorifier-plugin 62 | , categorifier-plugin-test 63 | , either ^>=5.0.1 64 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 65 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 66 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 67 | 68 | test-suite categories-hierarchy 69 | import: hierarchy-tests 70 | type: exitcode-stdio-1.0 71 | main-is: Categories/Main.hs 72 | ghc-options: 73 | -O0 74 | 75 | test-suite categories-hierarchy-optimized 76 | import: hierarchy-tests 77 | type: exitcode-stdio-1.0 78 | main-is: Categories/Main.hs 79 | ghc-options: 80 | -O2 81 | -fignore-interface-pragmas 82 | -------------------------------------------------------------------------------- /integrations/categories/integration/Categorifier/Hierarchy/Categories.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ApplicativeDo #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE StrictData #-} 4 | {-# LANGUAGE TemplateHaskellQuotes #-} 5 | 6 | -- | Defines various mappings between categorical representations and the plugin, allowing us to 7 | -- support transformations against different type class hierarchies. 8 | module Categorifier.Hierarchy.Categories 9 | ( hierarchy, 10 | ) 11 | where 12 | 13 | import Categorifier.Core.Types (CategoryStack, Lookup) 14 | import qualified Categorifier.GHC.Builtin as Plugins 15 | import qualified Categorifier.GHC.Core as Plugins 16 | import qualified Categorifier.GHC.Types as Plugins 17 | import Categorifier.Hierarchy 18 | ( First (..), 19 | Hierarchy (..), 20 | baseHierarchy, 21 | identifier, 22 | mkMethodApps, 23 | ) 24 | import qualified Control.Categorical.Functor 25 | import qualified Control.Category.Associative 26 | import qualified Control.Category.Braided 27 | import qualified Control.Category.Cartesian 28 | import qualified Control.Category.Cartesian.Closed 29 | import qualified Control.Category.Distributive 30 | 31 | -- | A hierarchy using the type classes available in the 32 | -- [@categories@](https://hackage.haskell.org/package/categories) library. This includes 33 | -- `baseHierarchy`, since this library also builds on that hierarchy.` However, it currently 34 | -- results in mixing stuff from @categories@ and the `Control.Arrow.Arrow` hierarchy, which is 35 | -- /not/ part of the expected @categories@ instances. It does illustrate that mixing hierarchies 36 | -- works, though. 37 | hierarchy :: Lookup (Hierarchy CategoryStack) 38 | hierarchy = 39 | fmap getFirst $ 40 | (<>) <$> fmap First hierarchy' <*> fmap First baseHierarchy 41 | 42 | -- | `hierarchy` without the bits from @base@. This is just separated out for clarity. It shouldn't 43 | -- be public. 44 | hierarchy' :: (Monad f) => Lookup (Hierarchy f) 45 | hierarchy' = do 46 | let tensor = Plugins.mkTyConTy (Plugins.tupleTyCon Plugins.Boxed 2) 47 | let absV = Nothing 48 | let abstCV = Nothing 49 | let acosV = Nothing 50 | let acoshV = Nothing 51 | let apV = Nothing 52 | let andV = Nothing 53 | let appendV = Nothing 54 | applyV <- 55 | pure <$> do 56 | op <- identifier 'Control.Category.Cartesian.Closed.apply 57 | pure $ \onDict cat a b -> mkMethodApps onDict op [cat] [a, b] [] 58 | let apply2V = Nothing 59 | let arctan2V = Nothing 60 | let asinV = Nothing 61 | let asinhV = Nothing 62 | let atanV = Nothing 63 | let atanhV = Nothing 64 | let bindV = Nothing 65 | let bottomV = Nothing 66 | let coerceV = Nothing 67 | let compareV = Nothing 68 | let composeV = Nothing 69 | let compose2V = Nothing 70 | let constV = Nothing 71 | let constraintV = Nothing 72 | let cosV = Nothing 73 | let coshV = Nothing 74 | curryV <- 75 | pure <$> do 76 | op <- identifier 'Control.Category.Cartesian.Closed.curry 77 | pure $ \onDict cat a b c -> mkMethodApps onDict op [cat] [a, b, c] [] 78 | distlV <- 79 | pure <$> do 80 | op <- identifier 'Control.Category.Distributive.distribute 81 | pure $ \onDict cat a b c -> mkMethodApps onDict op [cat] [a, b, c] [] 82 | let divV = Nothing 83 | let divideV = Nothing 84 | let doubleToFloatV = Nothing 85 | let equalV = Nothing 86 | let evenV = Nothing 87 | exlV <- 88 | pure <$> do 89 | op <- identifier 'Control.Category.Cartesian.fst 90 | pure $ \onDict cat a b -> mkMethodApps onDict op [cat] [a, b] [] 91 | let expV = Nothing 92 | exrV <- 93 | pure <$> do 94 | op <- identifier 'Control.Category.Cartesian.snd 95 | pure $ \onDict cat a b -> mkMethodApps onDict op [cat] [a, b] [] 96 | let fixV = Nothing 97 | let floatToDoubleV = Nothing 98 | let fmodV = Nothing 99 | forkV <- 100 | pure <$> do 101 | op <- identifier '(Control.Category.Cartesian.&&&) 102 | pure (\onDict cat a b c -> mkMethodApps onDict op [cat] [a, b, c] []) 103 | let fpIsNegativeZeroV = Nothing 104 | let fpIsInfiniteV = Nothing 105 | let fpIsFiniteV = Nothing 106 | let fpIsNaNV = Nothing 107 | let fpIsDenormalV = Nothing 108 | let fromIntegerV = Nothing 109 | let fromIntegralV = Nothing 110 | let geV = Nothing 111 | let gtV = Nothing 112 | let idV = Nothing 113 | let ifV = Nothing 114 | inlV <- 115 | pure <$> do 116 | op <- identifier 'Control.Category.Cartesian.inl 117 | pure $ \onDict cat a b -> mkMethodApps onDict op [cat] [a, b] [] 118 | inrV <- 119 | pure <$> do 120 | op <- identifier 'Control.Category.Cartesian.inr 121 | pure $ \onDict cat a b -> mkMethodApps onDict op [cat] [b, a] [] 122 | joinV <- 123 | pure <$> do 124 | op <- identifier '(Control.Category.Cartesian.|||) 125 | pure (\onDict cat a b c -> mkMethodApps onDict op [cat] [a, b, c] []) 126 | lassocV <- 127 | pure <$> do 128 | op <- identifier 'Control.Category.Associative.disassociate 129 | pure $ \onDict cat a b c -> mkMethodApps onDict op [cat, tensor] [a, b, c] [] 130 | let leV = Nothing 131 | let liftA2V = Nothing 132 | let logV = Nothing 133 | let ltV = Nothing 134 | mapV <- 135 | pure <$> do 136 | op <- identifier 'Control.Categorical.Functor.fmap 137 | pure (\onDict cat cat' f a b -> mkMethodApps onDict op [f, cat, cat'] [a, b] []) 138 | let maxV = Nothing 139 | let maximumV = Nothing 140 | let minV = Nothing 141 | let minimumV = Nothing 142 | let minusV = Nothing 143 | let modV = Nothing 144 | let nativeV = Nothing 145 | let negateV = Nothing 146 | let indexV = Nothing 147 | let tabulateV = Nothing 148 | let notV = Nothing 149 | let notEqualV = Nothing 150 | let oddV = Nothing 151 | let orV = Nothing 152 | let plusV = Nothing 153 | let pointV = Nothing 154 | let powV = Nothing 155 | let powIV = Nothing 156 | let powIntV = Nothing 157 | let quotV = Nothing 158 | rassocV <- 159 | pure <$> do 160 | op <- identifier 'Control.Category.Associative.associate 161 | pure $ \onDict cat a b c -> mkMethodApps onDict op [cat, tensor] [a, b, c] [] 162 | let realToFracV = Nothing 163 | let recipV = Nothing 164 | let remV = Nothing 165 | let reprCV = Nothing 166 | let sequenceAV = Nothing 167 | let signumV = Nothing 168 | let sinV = Nothing 169 | let sinhV = Nothing 170 | let sqrtV = Nothing 171 | let strengthV = Nothing 172 | let sumV = Nothing 173 | swapV <- 174 | pure <$> do 175 | op <- identifier 'Control.Category.Braided.braid 176 | pure $ \onDict cat a b -> mkMethodApps onDict op [cat, tensor] [a, b] [] 177 | let tanV = Nothing 178 | let tanhV = Nothing 179 | let timesV = Nothing 180 | let traverseV = Nothing 181 | uncurryV <- 182 | pure <$> do 183 | op <- identifier 'Control.Category.Cartesian.Closed.uncurry 184 | pure $ \onDict cat a b c -> mkMethodApps onDict op [cat] [a, b, c] [] 185 | pure Hierarchy {..} 186 | -------------------------------------------------------------------------------- /integrations/categories/integration/categorifier-categories-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-categories-integration 4 | version: 0.1 5 | description: Extensions to use Kmett's Categories with the plugin. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Hierarchy.Categories 43 | other-modules: 44 | Paths_categorifier_categories_integration 45 | autogen-modules: 46 | Paths_categorifier_categories_integration 47 | build-depends: 48 | , bytestring ^>=0.10.9 || ^>=0.11.0 49 | , categories ^>=1.0.7 50 | , categorifier-duoids 51 | , categorifier-ghc 52 | , categorifier-plugin 53 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 54 | , transformers ^>=0.5.6 || ^>=0.6.0 55 | -------------------------------------------------------------------------------- /integrations/concat-extensions/category/categorifier-concat-extensions-category.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-concat-extensions-category 4 | version: 0.1 5 | description: Categorical classes extending Conal's ConCat 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.ConCatExtensions 43 | other-modules: 44 | Paths_categorifier_concat_extensions_category 45 | autogen-modules: 46 | Paths_categorifier_concat_extensions_category 47 | ghc-options: 48 | -O2 49 | build-depends: 50 | , concat-classes 51 | -------------------------------------------------------------------------------- /integrations/concat-extensions/integration-test/categorifier-concat-extensions-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-concat-extensions-integration-test 4 | version: 0.1 5 | description: Plugin using our extensions to Conal's ConCat functions. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | , categorifier-concat-extensions-category 21 | , categorifier-plugin-test 22 | , concat-classes 23 | default-language: Haskell2010 24 | default-extensions: 25 | BangPatterns 26 | DeriveDataTypeable 27 | DeriveFoldable 28 | DeriveFunctor 29 | DeriveGeneric 30 | DeriveTraversable 31 | DerivingStrategies 32 | FlexibleContexts 33 | FlexibleInstances 34 | FunctionalDependencies 35 | InstanceSigs 36 | LambdaCase 37 | ScopedTypeVariables 38 | StandaloneDeriving 39 | TypeApplications 40 | TypeOperators 41 | 42 | library 43 | import: defaults 44 | exposed-modules: 45 | Categorifier.Test.ConCatExtensions.Instances 46 | build-depends: 47 | , categorifier-concat-integration-test 48 | 49 | common hierarchy-tests 50 | import: defaults 51 | hs-source-dirs: test 52 | ghc-options: 53 | -- make it possible to inline almost anything 54 | -fexpose-all-unfoldings 55 | -- ensure unfoldings are available 56 | -fno-omit-interface-pragmas 57 | -fplugin Categorifier 58 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.functionHierarchy 59 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCatExtensions.hierarchy 60 | build-depends: 61 | , adjunctions ^>=4.4 62 | , categorifier-category 63 | , categorifier-client 64 | , categorifier-concat-integration 65 | , categorifier-concat-extensions-integration 66 | , categorifier-concat-extensions-integration-test 67 | , categorifier-hedgehog 68 | , categorifier-plugin 69 | , concat-examples 70 | , either ^>=5.0.1 71 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 72 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 73 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 74 | 75 | test-suite concat-extensions-hierarchy 76 | import: hierarchy-tests 77 | type: exitcode-stdio-1.0 78 | main-is: ConCatExtensions/Main.hs 79 | ghc-options: 80 | -O0 81 | 82 | test-suite concat-extensions-hierarchy-optimized 83 | import: hierarchy-tests 84 | type: exitcode-stdio-1.0 85 | hs-source-dirs: test 86 | main-is: ConCatExtensions/Main.hs 87 | ghc-options: 88 | -O2 89 | -fignore-interface-pragmas 90 | -------------------------------------------------------------------------------- /integrations/concat-extensions/integration/categorifier-concat-extensions-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-concat-extensions-integration 4 | version: 0.1 5 | description: Extensions to Conal's ConCat to improve plugin coverage. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Hierarchy.ConCatExtensions 43 | other-modules: 44 | Paths_categorifier_concat_extensions_integration 45 | autogen-modules: 46 | Paths_categorifier_concat_extensions_integration 47 | build-depends: 48 | , bytestring ^>=0.10.9 || ^>=0.11.0 49 | , categorifier-category 50 | , categorifier-concat-extensions-category 51 | , categorifier-duoids 52 | , categorifier-ghc 53 | , categorifier-plugin 54 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 55 | , transformers ^>=0.5.6 || ^>=0.6.0 56 | -------------------------------------------------------------------------------- /integrations/concat/examples/Categorifier/ConCat/Examples/Syntactic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# OPTIONS_GHC -Wno-orphans #-} 3 | 4 | -- | This is intended to be used /instead/ of "ConCat.Syntactic" when using the "Categorifier" 5 | -- plugin. 6 | module Categorifier.ConCat.Examples.Syntactic 7 | ( module ConCat.Syntactic, 8 | ) 9 | where 10 | 11 | import qualified Categorifier.Category as Categorifier 12 | import qualified Categorifier.Client as Categorifier 13 | import ConCat.Syntactic 14 | 15 | instance 16 | (Categorifier.HasRep a, r ~ Categorifier.Rep a, T a, T r) => 17 | Categorifier.RepCat Syn a r 18 | where 19 | abstC = app0' "abst" 20 | reprC = app0' "repr" 21 | 22 | instance Categorifier.UnsafeCoerceCat Syn a b where 23 | unsafeCoerceK = app0' "unsafeCoerce" 24 | -------------------------------------------------------------------------------- /integrations/concat/examples/categorifier-concat-examples.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-concat-examples 4 | version: 0.1 5 | description: Extra instances to use concat-examples with Categorifier. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.ConCat.Examples.Syntactic 43 | other-modules: 44 | Paths_categorifier_concat_examples 45 | autogen-modules: 46 | Paths_categorifier_concat_examples 47 | build-depends: 48 | , bytestring ^>=0.10.9 || ^>=0.11.0 49 | , categorifier-category 50 | , categorifier-client 51 | , concat-examples 52 | , ghc ^>=8.8.1 || ^>=8.10.1 || ^>=9.0.1 || ^>=9.2.1 53 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 54 | , transformers ^>=0.5.6 || ^>=0.6.0 55 | -------------------------------------------------------------------------------- /integrations/concat/integration-test/Categorifier/Test/TotOrd.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | {-# OPTIONS_GHC -Wno-orphans #-} 7 | 8 | module Categorifier.Test.TotOrd 9 | ( TotOrd (..), 10 | runTotOrd, 11 | ) 12 | where 13 | 14 | import Categorifier.Category (RepCat (..), UnsafeCoerceCat (..)) 15 | import qualified Categorifier.Client as Client 16 | import qualified ConCat.Category as ConCat 17 | 18 | -- | The category of totally ordered sets. This is an example for testing constrained categories 19 | -- (full subcategories). This category is /not/ closed. 20 | -- 21 | -- Unfortunately, the definition of constrained categories is tied to the hierarchy, so this is 22 | -- not as general as the other categories we're testing. 23 | newtype TotOrd a b = TotOrd {runTotConstrained :: ConCat.Constrained Ord (->) a b} 24 | deriving newtype 25 | ( ConCat.BoolCat, 26 | ConCat.BraidedPCat, 27 | ConCat.Category, 28 | ConCat.CoproductCat, 29 | ConCat.MonoidalPCat, 30 | ConCat.MonoidalSCat, 31 | ConCat.ProductCat 32 | ) 33 | 34 | runTotOrd :: TotOrd a b -> a -> b 35 | runTotOrd = (\(ConCat.Constrained f) -> f) . runTotConstrained 36 | 37 | instance (RepCat k a r, con a, con r) => RepCat (ConCat.Constrained con k) a r where 38 | abstC = ConCat.Constrained abstC 39 | reprC = ConCat.Constrained reprC 40 | 41 | instance (UnsafeCoerceCat k a b) => UnsafeCoerceCat (ConCat.Constrained con k) a b where 42 | unsafeCoerceK = ConCat.Constrained unsafeCoerceK 43 | 44 | instance (Ord b) => ConCat.ConstCat TotOrd b where 45 | const = TotOrd . ConCat.const 46 | 47 | instance ConCat.OkFunctor TotOrd f where 48 | okFunctor = ConCat.okFunctor @TotOrd 49 | 50 | instance (Functor f) => ConCat.FunctorCat TotOrd f where 51 | fmapC (TotOrd fn) = TotOrd $ ConCat.fmapC fn 52 | unzipC = TotOrd ConCat.unzipC 53 | 54 | instance (Ord a) => ConCat.EqCat TotOrd a where 55 | equal = TotOrd ConCat.equal 56 | 57 | instance (Ord a) => ConCat.OrdCat TotOrd a where 58 | lessThan = TotOrd ConCat.lessThan 59 | 60 | instance (Num a, Ord a) => ConCat.NumCat TotOrd a where 61 | negateC = TotOrd ConCat.negateC 62 | addC = TotOrd ConCat.addC 63 | subC = TotOrd ConCat.subC 64 | mulC = TotOrd ConCat.mulC 65 | powIC = TotOrd ConCat.powIC 66 | 67 | instance (Integral a, Num b, Ord b) => ConCat.FromIntegralCat TotOrd a b where 68 | fromIntegralC = TotOrd ConCat.fromIntegralC 69 | 70 | instance (Fractional a, Ord a) => ConCat.FractionalCat TotOrd a where 71 | divideC = TotOrd ConCat.divideC 72 | recipC = TotOrd ConCat.recipC 73 | 74 | instance (Client.HasRep a, r ~ Client.Rep a, Ord a, Ord r) => RepCat TotOrd a r where 75 | abstC = TotOrd abstC 76 | reprC = TotOrd reprC 77 | 78 | instance UnsafeCoerceCat TotOrd a b where 79 | unsafeCoerceK = TotOrd unsafeCoerceK 80 | 81 | instance (Floating a, Ord a) => ConCat.FloatingCat TotOrd a where 82 | cosC = TotOrd ConCat.cosC 83 | expC = TotOrd ConCat.expC 84 | logC = TotOrd ConCat.logC 85 | sinC = TotOrd ConCat.sinC 86 | sqrtC = TotOrd ConCat.sqrtC 87 | tanhC = TotOrd ConCat.tanhC 88 | 89 | instance (Applicative m, Ord a) => ConCat.PointedCat TotOrd m a where 90 | pointC = TotOrd ConCat.pointC 91 | 92 | instance (Ord a) => ConCat.IfCat TotOrd a where 93 | ifC = TotOrd ConCat.ifC 94 | 95 | instance (Ord a, Ord b) => ConCat.BottomCat TotOrd a b where 96 | bottomC = TotOrd ConCat.bottomC 97 | 98 | instance ConCat.TracedCat TotOrd where 99 | trace (TotOrd fn) = TotOrd $ ConCat.trace fn 100 | -------------------------------------------------------------------------------- /integrations/concat/integration-test/categorifier-concat-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-concat-integration-test 4 | version: 0.1 5 | description: Utilities for testing ConCat and extensions of it. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | build-depends: 17 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 18 | , categorifier-category 19 | , categorifier-client 20 | , categorifier-plugin-test 21 | , concat-classes 22 | , concat-examples 23 | ghc-options: 24 | -Wall 25 | default-language: Haskell2010 26 | default-extensions: 27 | BangPatterns 28 | DeriveDataTypeable 29 | DeriveFoldable 30 | DeriveFunctor 31 | DeriveGeneric 32 | DeriveTraversable 33 | DerivingStrategies 34 | FlexibleContexts 35 | FlexibleInstances 36 | FunctionalDependencies 37 | InstanceSigs 38 | LambdaCase 39 | ScopedTypeVariables 40 | StandaloneDeriving 41 | TypeApplications 42 | TypeOperators 43 | 44 | library 45 | import: defaults 46 | exposed-modules: 47 | Categorifier.Test.ConCat.Instances 48 | Categorifier.Test.TotOrd 49 | build-depends: 50 | , constraints ^>=0.12.0 || ^>=0.13.0 51 | 52 | common hierarchy-tests 53 | import: defaults 54 | hs-source-dirs: test 55 | ghc-options: 56 | -- make it possible to inline almost anything 57 | -fexpose-all-unfoldings 58 | -- ensure unfoldings are available 59 | -fno-omit-interface-pragmas 60 | -fplugin Categorifier 61 | -fplugin-opt Categorifier:defer-failures 62 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.classHierarchy 63 | -fplugin-opt Categorifier:maker-map:Categorifier.Core.MakerMap.baseMakerMapFun 64 | -- ConCat includes support for `index` and `tabulate` 65 | -fplugin-opt Categorifier:maker-map:Categorifier.Adjunctions.Integration.makerMapFun 66 | build-depends: 67 | , adjunctions ^>=4.4 68 | , categorifier-adjunctions-integration 69 | , categorifier-adjunctions-integration-test 70 | , categorifier-concat-integration 71 | , categorifier-concat-integration-test 72 | , categorifier-hedgehog 73 | , categorifier-plugin 74 | , either ^>=5.0.1 75 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 76 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 77 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 78 | 79 | test-suite concat-class-hierarchy 80 | import: hierarchy-tests 81 | type: exitcode-stdio-1.0 82 | main-is: ConCat/Main.hs 83 | ghc-options: 84 | -O0 85 | 86 | test-suite concat-class-hierarchy-optimized 87 | import: hierarchy-tests 88 | type: exitcode-stdio-1.0 89 | main-is: ConCat/Main.hs 90 | ghc-options: 91 | -O2 92 | -fignore-interface-pragmas 93 | 94 | test-suite concat-function-hierarchy 95 | import: hierarchy-tests 96 | type: exitcode-stdio-1.0 97 | main-is: ConCat/Main.hs 98 | ghc-options: 99 | -O0 100 | 101 | test-suite concat-function-hierarchy-optimized 102 | import: hierarchy-tests 103 | type: exitcode-stdio-1.0 104 | main-is: ConCat/Main.hs 105 | ghc-options: 106 | -O2 107 | -fignore-interface-pragmas 108 | -------------------------------------------------------------------------------- /integrations/concat/integration/categorifier-concat-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-concat-integration 4 | version: 0.1 5 | description: Extensions to use Conal's ConCat with the plugin. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Hierarchy.ConCat 43 | other-modules: 44 | Paths_categorifier_concat_integration 45 | autogen-modules: 46 | Paths_categorifier_concat_integration 47 | build-depends: 48 | , bytestring ^>=0.10.9 || ^>=0.11.0 49 | , categorifier-category 50 | , categorifier-client 51 | , categorifier-duoids 52 | , categorifier-ghc 53 | , categorifier-plugin 54 | , concat-classes 55 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 56 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 57 | , transformers ^>=0.5.6 || ^>=0.6.0 58 | -------------------------------------------------------------------------------- /integrations/fin/integration/Categorifier/Fin/Client.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | {-# OPTIONS_GHC -Wno-orphans #-} 5 | 6 | module Categorifier.Fin.Client 7 | ( HasRep (..), 8 | Rep, 9 | deriveHasRep, 10 | ) 11 | where 12 | 13 | import Categorifier.Client (HasRep (..), Rep, deriveHasRep) 14 | import Data.Fin (Fin) 15 | import Data.Type.Nat (Nat (..), SNat (..)) 16 | 17 | deriveHasRep ''Fin 18 | 19 | deriveHasRep ''Nat 20 | 21 | deriveHasRep ''SNat 22 | -------------------------------------------------------------------------------- /integrations/fin/integration/categorifier-fin-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-fin-integration 4 | version: 0.1 5 | description: Extensions to Conal's ConCat to improve plugin coverage. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Fin.Client 43 | other-modules: 44 | Paths_categorifier_fin_integration 45 | autogen-modules: 46 | Paths_categorifier_fin_integration 47 | build-depends: 48 | , categorifier-client 49 | , categorifier-duoids 50 | , categorifier-ghc 51 | , categorifier-plugin 52 | , containers ^>=0.6.2 53 | , fin ^>=0.1.1 || ^>=0.2 || ^>=0.3 54 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 55 | , transformers ^>=0.5.6 || ^>=0.6.0 56 | -------------------------------------------------------------------------------- /integrations/ghc-bignum/integration-test/Categorifier/Test/GhcBignum.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DerivingVia #-} 3 | {-# LANGUAGE LinearTypes #-} 4 | {-# LANGUAGE MagicHash #-} 5 | -- To avoid having to specify massive HList types. 6 | {-# LANGUAGE PartialTypeSignatures #-} 7 | {-# LANGUAGE PolyKinds #-} 8 | {-# LANGUAGE TemplateHaskellQuotes #-} 9 | {-# LANGUAGE TupleSections #-} 10 | -- To avoid having to specify massive HList types. 11 | {-# OPTIONS_GHC -Wno-partial-type-signatures #-} 12 | 13 | module Categorifier.Test.GhcBignum 14 | ( testTerms, 15 | ) 16 | where 17 | 18 | import Categorifier.Test.HList (HMap1 (..)) 19 | import Categorifier.Test.TH (mkBinaryTestConfig, mkUnaryTestConfig) 20 | import Categorifier.Test.Tests (TestTerms, insertTest) 21 | import Data.Proxy (Proxy (..)) 22 | import qualified GHC.Num.Integer 23 | import GHC.Num.Natural (Natural) 24 | import qualified GHC.Num.Natural 25 | 26 | testTerms :: TestTerms _ 27 | testTerms = 28 | insertTest 29 | (Proxy @"EqualInteger") 30 | mkBinaryTestConfig 31 | (\() -> ([t|Integer|], [t|Integer -> Bool|])) 32 | [|GHC.Num.Integer.integerEq|] 33 | . insertTest 34 | (Proxy @"NotEqualInteger") 35 | mkBinaryTestConfig 36 | (\() -> ([t|Integer|], [t|Integer -> Bool|])) 37 | [|GHC.Num.Integer.integerNe|] 38 | . insertTest 39 | (Proxy @"GeInteger") 40 | mkBinaryTestConfig 41 | (\() -> ([t|Integer|], [t|Integer -> Bool|])) 42 | [|GHC.Num.Integer.integerGe|] 43 | . insertTest 44 | (Proxy @"GtInteger") 45 | mkBinaryTestConfig 46 | (\() -> ([t|Integer|], [t|Integer -> Bool|])) 47 | [|GHC.Num.Integer.integerGt|] 48 | . insertTest 49 | (Proxy @"LeInteger") 50 | mkBinaryTestConfig 51 | (\() -> ([t|Integer|], [t|Integer -> Bool|])) 52 | [|GHC.Num.Integer.integerLe|] 53 | . insertTest 54 | (Proxy @"LtInteger") 55 | mkBinaryTestConfig 56 | (\() -> ([t|Integer|], [t|Integer -> Bool|])) 57 | [|GHC.Num.Integer.integerLt|] 58 | . insertTest 59 | (Proxy @"CompareInteger") 60 | mkBinaryTestConfig 61 | (\() -> ([t|Integer|], [t|Integer -> Ordering|])) 62 | [|GHC.Num.Integer.integerCompare|] 63 | . insertTest 64 | (Proxy @"PlusInteger") 65 | mkBinaryTestConfig 66 | (\() -> ([t|Integer|], [t|Integer -> Integer|])) 67 | [|GHC.Num.Integer.integerAdd|] 68 | . insertTest 69 | (Proxy @"MinusInteger") 70 | mkBinaryTestConfig 71 | (\() -> ([t|Integer|], [t|Integer -> Integer|])) 72 | [|GHC.Num.Integer.integerSub|] 73 | . insertTest 74 | (Proxy @"TimesInteger") 75 | mkBinaryTestConfig 76 | (\() -> ([t|Integer|], [t|Integer -> Integer|])) 77 | [|GHC.Num.Integer.integerMul|] 78 | . insertTest 79 | (Proxy @"NegateInteger") 80 | mkUnaryTestConfig 81 | (\() -> ([t|Integer|], [t|Integer|])) 82 | [|GHC.Num.Integer.integerNegate|] 83 | . insertTest 84 | (Proxy @"AbsInteger") 85 | mkUnaryTestConfig 86 | (\() -> ([t|Integer|], [t|Integer|])) 87 | [|GHC.Num.Integer.integerNegate|] 88 | . insertTest 89 | (Proxy @"SignumInteger") 90 | mkUnaryTestConfig 91 | (\() -> ([t|Integer|], [t|Integer|])) 92 | [|GHC.Num.Integer.integerSignum|] 93 | . insertTest 94 | (Proxy @"QuotInteger") 95 | mkBinaryTestConfig 96 | (\() -> ([t|Integer|], [t|Integer -> Integer|])) 97 | [|GHC.Num.Integer.integerQuot|] 98 | . insertTest 99 | (Proxy @"RemInteger") 100 | mkBinaryTestConfig 101 | (\() -> ([t|Integer|], [t|Integer -> Integer|])) 102 | [|GHC.Num.Integer.integerRem|] 103 | . insertTest 104 | (Proxy @"EqualNatural") 105 | mkBinaryTestConfig 106 | (\() -> ([t|Natural|], [t|Natural -> Bool|])) 107 | [|GHC.Num.Natural.naturalEq|] 108 | . insertTest 109 | (Proxy @"NotEqualNatural") 110 | mkBinaryTestConfig 111 | (\() -> ([t|Natural|], [t|Natural -> Bool|])) 112 | [|GHC.Num.Natural.naturalNe|] 113 | . insertTest 114 | (Proxy @"GeNatural") 115 | mkBinaryTestConfig 116 | (\() -> ([t|Natural|], [t|Natural -> Bool|])) 117 | [|GHC.Num.Natural.naturalGe|] 118 | . insertTest 119 | (Proxy @"GtNatural") 120 | mkBinaryTestConfig 121 | (\() -> ([t|Natural|], [t|Natural -> Bool|])) 122 | [|GHC.Num.Natural.naturalGt|] 123 | . insertTest 124 | (Proxy @"LeNatural") 125 | mkBinaryTestConfig 126 | (\() -> ([t|Natural|], [t|Natural -> Bool|])) 127 | [|GHC.Num.Natural.naturalLe|] 128 | . insertTest 129 | (Proxy @"LtNatural") 130 | mkBinaryTestConfig 131 | (\() -> ([t|Natural|], [t|Natural -> Bool|])) 132 | [|GHC.Num.Natural.naturalLt|] 133 | . insertTest 134 | (Proxy @"CompareNatural") 135 | mkBinaryTestConfig 136 | (\() -> ([t|Natural|], [t|Natural -> Ordering|])) 137 | [|GHC.Num.Natural.naturalCompare|] 138 | . insertTest 139 | (Proxy @"PlusNatural") 140 | mkBinaryTestConfig 141 | (\() -> ([t|Natural|], [t|Natural -> Natural|])) 142 | [|GHC.Num.Natural.naturalAdd|] 143 | . insertTest 144 | (Proxy @"MinusNaturalThrow") 145 | mkBinaryTestConfig 146 | (\() -> ([t|Natural|], [t|Natural -> Natural|])) 147 | [|GHC.Num.Natural.naturalSubThrow|] 148 | . insertTest 149 | (Proxy @"MinusNaturalUnsafe") 150 | mkBinaryTestConfig 151 | (\() -> ([t|Natural|], [t|Natural -> Natural|])) 152 | [|GHC.Num.Natural.naturalSubUnsafe|] 153 | . insertTest 154 | (Proxy @"TimesNatural") 155 | mkBinaryTestConfig 156 | (\() -> ([t|Natural|], [t|Natural -> Natural|])) 157 | [|GHC.Num.Natural.naturalMul|] 158 | . insertTest 159 | (Proxy @"SignumNatural") 160 | mkUnaryTestConfig 161 | (\() -> ([t|Natural|], [t|Natural|])) 162 | [|GHC.Num.Natural.naturalSignum|] 163 | . insertTest 164 | (Proxy @"NegateNatural") 165 | mkUnaryTestConfig 166 | (\() -> ([t|Natural|], [t|Natural|])) 167 | [|GHC.Num.Natural.naturalNegate|] 168 | . insertTest 169 | (Proxy @"QuotNatural") 170 | mkBinaryTestConfig 171 | (\() -> ([t|Natural|], [t|Natural -> Natural|])) 172 | [|GHC.Num.Natural.naturalQuot|] 173 | . insertTest 174 | (Proxy @"RemNatural") 175 | mkBinaryTestConfig 176 | (\() -> ([t|Natural|], [t|Natural -> Natural|])) 177 | [|GHC.Num.Natural.naturalRem|] 178 | $ HEmpty1 179 | -------------------------------------------------------------------------------- /integrations/ghc-bignum/integration-test/categorifier-ghc-bignum-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-ghc-bignum-integration-test 4 | version: 0.1 5 | description: Test utilities for Categorifier's `ghc-bignum` integration. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | , categorifier-plugin-test 21 | , constraints ^>=0.12.0 || ^>=0.13.0 22 | default-language: Haskell2010 23 | default-extensions: 24 | BangPatterns 25 | DeriveDataTypeable 26 | DeriveFoldable 27 | DeriveFunctor 28 | DeriveGeneric 29 | DeriveTraversable 30 | DerivingStrategies 31 | FlexibleContexts 32 | FlexibleInstances 33 | FunctionalDependencies 34 | InstanceSigs 35 | LambdaCase 36 | ScopedTypeVariables 37 | StandaloneDeriving 38 | TypeApplications 39 | TypeOperators 40 | 41 | library 42 | import: defaults 43 | exposed-modules: 44 | Categorifier.Test.GhcBignum 45 | 46 | common hierarchy-tests 47 | import: defaults 48 | hs-source-dirs: test 49 | ghc-options: 50 | -- make it possible to inline almost anything 51 | -fexpose-all-unfoldings 52 | -- ensure unfoldings are available 53 | -fno-omit-interface-pragmas 54 | -fplugin Categorifier 55 | -fplugin-opt Categorifier:defer-failures 56 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.classHierarchy 57 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCatExtensions.hierarchy 58 | -fplugin-opt Categorifier:lookup:Categorifier.GhcBignum.Integration.symbolLookup 59 | -fplugin-opt Categorifier:lookup:Categorifier.Core.MakerMap.baseSymbolLookup 60 | -fplugin-opt Categorifier:maker-map:Categorifier.GhcBignum.Integration.makerMapFun 61 | -fplugin-opt Categorifier:maker-map:Categorifier.Core.MakerMap.baseMakerMapFun 62 | build-depends: 63 | , categorifier-category 64 | , categorifier-client 65 | , categorifier-concat-extensions-category 66 | , categorifier-concat-extensions-integration 67 | , categorifier-concat-extensions-integration-test 68 | , categorifier-concat-integration 69 | , categorifier-concat-integration-test 70 | , categorifier-hedgehog 71 | , categorifier-ghc-bignum-integration 72 | , categorifier-ghc-bignum-integration-test 73 | , categorifier-plugin 74 | , concat-classes 75 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 76 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 77 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 78 | 79 | test-suite ghc-bignum-hierarchy 80 | import: hierarchy-tests 81 | type: exitcode-stdio-1.0 82 | main-is: GhcBignum/Main.hs 83 | ghc-options: 84 | -O0 85 | 86 | test-suite ghc-bignum-hierarchy-optimized 87 | import: hierarchy-tests 88 | type: exitcode-stdio-1.0 89 | main-is: GhcBignum/Main.hs 90 | ghc-options: 91 | -O2 92 | -fignore-interface-pragmas 93 | -------------------------------------------------------------------------------- /integrations/ghc-bignum/integration-test/test/GhcBignum/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE MagicHash #-} 3 | {-# LANGUAGE MultiWayIf #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE TupleSections #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | -- To avoid turning @if then else@ into `ifThenElse`. 9 | {-# LANGUAGE NoRebindableSyntax #-} 10 | {-# OPTIONS_GHC -Wno-orphans #-} 11 | 12 | -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. 13 | module Main 14 | ( main, 15 | ) 16 | where 17 | 18 | import Categorifier.Hedgehog (genInteger, genNatural, genNaturalFrom) 19 | import Categorifier.Test.ConCat.Instances () 20 | import Categorifier.Test.ConCatExtensions.Instances () 21 | import qualified Categorifier.Test.GhcBignum as GhcBignum 22 | import Categorifier.Test.HList (HMap1 (..)) 23 | import Categorifier.Test.Hask (Hask (..)) 24 | import Categorifier.Test.Term (Term (..)) 25 | import Categorifier.Test.Tests 26 | ( TestCases (..), 27 | TestCategory (..), 28 | TestStrategy (..), 29 | builtinTestCategories, 30 | mkTestTerms, 31 | ) 32 | import Data.Bool (bool) 33 | import Data.Proxy (Proxy (..)) 34 | import qualified Hedgehog.Gen as Gen 35 | import System.Exit (exitFailure, exitSuccess) 36 | 37 | -- For @NoRebindableSyntax@ 38 | {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} 39 | 40 | mkTestTerms 41 | GhcBignum.testTerms 42 | -- name type prefix strategy 43 | ( [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, 44 | TestCategory ''Hask [t|Hask|] "hask" $ ComputeFromInput [|runHask|] 45 | ] 46 | <> builtinTestCategories 47 | ) 48 | -- ghc-bignum 49 | . HInsert1 50 | (Proxy @"EqualInteger") 51 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 52 | . HInsert1 53 | (Proxy @"NotEqualInteger") 54 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 55 | . HInsert1 56 | (Proxy @"GeInteger") 57 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 58 | . HInsert1 59 | (Proxy @"GtInteger") 60 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 61 | . HInsert1 62 | (Proxy @"LeInteger") 63 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 64 | . HInsert1 65 | (Proxy @"LtInteger") 66 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 67 | . HInsert1 68 | (Proxy @"CompareInteger") 69 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 70 | . HInsert1 71 | (Proxy @"PlusInteger") 72 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 73 | . HInsert1 74 | (Proxy @"MinusInteger") 75 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 76 | . HInsert1 77 | (Proxy @"TimesInteger") 78 | (TestCases (const [((), pure ([|(,) <$> genInteger <*> genInteger|], [|show|]))])) 79 | . HInsert1 80 | (Proxy @"NegateInteger") 81 | (TestCases (const [((), pure ([|genInteger|], [|show|]))])) 82 | . HInsert1 83 | (Proxy @"AbsInteger") 84 | (TestCases (const [((), pure ([|genInteger|], [|show|]))])) 85 | . HInsert1 86 | (Proxy @"SignumInteger") 87 | (TestCases (const [((), pure ([|genInteger|], [|show|]))])) 88 | . HInsert1 89 | (Proxy @"QuotInteger") 90 | ( TestCases 91 | (const [((), pure ([|(,) <$> genInteger <*> Gen.filter (/= 0) genInteger|], [|show|]))]) 92 | ) 93 | . HInsert1 94 | (Proxy @"RemInteger") 95 | ( TestCases 96 | (const [((), pure ([|(,) <$> genInteger <*> Gen.filter (/= 0) genInteger|], [|show|]))]) 97 | ) 98 | . HInsert1 99 | (Proxy @"EqualNatural") 100 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 101 | . HInsert1 102 | (Proxy @"NotEqualNatural") 103 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 104 | . HInsert1 105 | (Proxy @"GeNatural") 106 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 107 | . HInsert1 108 | (Proxy @"GtNatural") 109 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 110 | . HInsert1 111 | (Proxy @"LeNatural") 112 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 113 | . HInsert1 114 | (Proxy @"LtNatural") 115 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 116 | . HInsert1 117 | (Proxy @"CompareNatural") 118 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 119 | . HInsert1 120 | (Proxy @"PlusNatural") 121 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 122 | . HInsert1 123 | (Proxy @"MinusNaturalThrow") 124 | ( TestCases 125 | ( const 126 | [ ( (), 127 | pure 128 | ( [|(\subtrahend -> (,subtrahend) <$> genNaturalFrom subtrahend) =<< genNatural|], 129 | [|show|] 130 | ) 131 | ) 132 | ] 133 | ) 134 | ) 135 | . HInsert1 136 | (Proxy @"MinusNaturalUnsafe") 137 | ( TestCases 138 | ( const 139 | [ ( (), 140 | pure 141 | ( [|(\subtrahend -> (,subtrahend) <$> genNaturalFrom subtrahend) =<< genNatural|], 142 | [|show|] 143 | ) 144 | ) 145 | ] 146 | ) 147 | ) 148 | . HInsert1 149 | (Proxy @"TimesNatural") 150 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNatural|], [|show|]))])) 151 | . HInsert1 152 | (Proxy @"SignumNatural") 153 | (TestCases (const [((), pure ([|genNatural|], [|show|]))])) 154 | . HInsert1 155 | (Proxy @"NegateNatural") 156 | (TestCases (const [((), pure ([|Gen.constant 0|], [|show|]))])) 157 | . HInsert1 158 | (Proxy @"QuotNatural") 159 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNaturalFrom 1|], [|show|]))])) 160 | . HInsert1 161 | (Proxy @"RemNatural") 162 | (TestCases (const [((), pure ([|(,) <$> genNatural <*> genNaturalFrom 1|], [|show|]))])) 163 | $ HEmpty1 164 | 165 | main :: IO () 166 | main = bool exitFailure exitSuccess . and =<< allTestTerms 167 | -------------------------------------------------------------------------------- /integrations/ghc-bignum/integration/categorifier-ghc-bignum-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-ghc-bignum-integration 4 | version: 0.1 5 | summary: Support for categorizing operations from `ghc-bignum`. 6 | description: In GHC 9, bignum implementations were moved to a new package and changed to support 7 | multiple backends. That move introduced new operations (rather than deriving 8 | instances) that need to be handled for Categorifier. This package provides the 9 | Categorifier support. 10 | homepage: https://github.com/con-kitty/categorifier#readme 11 | bug-reports: https://github.com/con-kitty/categorifier/issues 12 | build-type: Simple 13 | tested-with: GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 14 | 15 | source-repository head 16 | type: git 17 | location: https://github.com/con-kitty/categorifier 18 | 19 | common defaults 20 | ghc-options: 21 | -Wall 22 | build-depends: 23 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 24 | default-language: Haskell2010 25 | default-extensions: 26 | BangPatterns 27 | DeriveDataTypeable 28 | DeriveFoldable 29 | DeriveFunctor 30 | DeriveGeneric 31 | DeriveTraversable 32 | DerivingStrategies 33 | FlexibleContexts 34 | FlexibleInstances 35 | FunctionalDependencies 36 | InstanceSigs 37 | LambdaCase 38 | ScopedTypeVariables 39 | StandaloneDeriving 40 | TypeApplications 41 | TypeOperators 42 | 43 | library 44 | import: defaults 45 | exposed-modules: 46 | Categorifier.GhcBignum.Integration 47 | other-modules: 48 | Paths_categorifier_ghc_bignum_integration 49 | autogen-modules: 50 | Paths_categorifier_ghc_bignum_integration 51 | build-depends: 52 | , categorifier-client 53 | , categorifier-duoids 54 | , categorifier-ghc 55 | , categorifier-plugin 56 | , containers ^>=0.6.2 57 | , constraints ^>=0.12.0 || ^>=0.13.0 58 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 59 | -------------------------------------------------------------------------------- /integrations/linear-base/integration-test/categorifier-linear-base-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-linear-base-integration-test 4 | version: 0.1 5 | description: Test utilities for categorifier's linear-base integration. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0, 20 | categorifier-plugin-test, 21 | linear-base ^>=0.3.0, 22 | pointed ^>=5.0.0, 23 | default-language: Haskell2010 24 | default-extensions: 25 | BangPatterns 26 | DeriveDataTypeable 27 | DeriveFoldable 28 | DeriveFunctor 29 | DeriveGeneric 30 | DeriveTraversable 31 | DerivingStrategies 32 | FlexibleContexts 33 | FlexibleInstances 34 | FunctionalDependencies 35 | InstanceSigs 36 | LambdaCase 37 | ScopedTypeVariables 38 | StandaloneDeriving 39 | TypeApplications 40 | TypeOperators 41 | 42 | library 43 | import: defaults 44 | exposed-modules: 45 | Categorifier.Test.LinearBase 46 | 47 | common hierarchy-tests 48 | import: defaults 49 | hs-source-dirs: test 50 | ghc-options: 51 | -- make it possible to inline almost anything 52 | -fexpose-all-unfoldings 53 | -- ensure unfoldings are available 54 | -fno-omit-interface-pragmas 55 | -fplugin Categorifier 56 | -fplugin-opt Categorifier:defer-failures 57 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.classHierarchy 58 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCatExtensions.hierarchy 59 | -fplugin-opt Categorifier:lookup:Categorifier.LinearBase.Integration.symbolLookup 60 | -fplugin-opt Categorifier:lookup:Categorifier.Core.MakerMap.baseSymbolLookup 61 | -fplugin-opt Categorifier:maker-map:Categorifier.LinearBase.Integration.makerMapFun 62 | -fplugin-opt Categorifier:maker-map:Categorifier.Core.MakerMap.baseMakerMapFun 63 | build-depends: 64 | , categorifier-category 65 | , categorifier-client 66 | , categorifier-concat-extensions-category 67 | , categorifier-concat-extensions-integration 68 | , categorifier-concat-extensions-integration-test 69 | , categorifier-concat-integration 70 | , categorifier-concat-integration-test 71 | , categorifier-hedgehog 72 | , categorifier-linear-base-integration 73 | , categorifier-linear-base-integration-test 74 | , categorifier-plugin 75 | , concat-classes 76 | , either ^>=5.0.1 77 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 78 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 79 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 80 | 81 | test-suite linear-base-hierarchy 82 | import: hierarchy-tests 83 | type: exitcode-stdio-1.0 84 | main-is: LinearBase/Main.hs 85 | ghc-options: 86 | -O0 87 | 88 | test-suite linear-base-hierarchy-optimized 89 | import: hierarchy-tests 90 | type: exitcode-stdio-1.0 91 | main-is: LinearBase/Main.hs 92 | ghc-options: 93 | -O2 94 | -fignore-interface-pragmas 95 | -------------------------------------------------------------------------------- /integrations/linear-base/integration/Categorifier/LinearBase/Client.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | {-# OPTIONS_GHC -Wno-orphans #-} 4 | 5 | module Categorifier.LinearBase.Client 6 | ( HasRep (..), 7 | deriveHasRep, 8 | ) 9 | where 10 | 11 | import Categorifier.Client (HasRep (..), deriveHasRep) 12 | import Control.Functor.Linear (Data, ReaderT, StateT) 13 | import Control.Optics.Linear (Optic_) 14 | import Data.Arity.Linear (Peano) 15 | import Data.Array.Destination (DArray) 16 | import qualified Data.Array.Polarized.Pull as Pull 17 | import Data.HashMap.Mutable.Linear (HashMap) 18 | import Data.Monoid.Linear (Endo, NonLinear) 19 | import Data.Profunctor.Kleisli.Linear (CoKleisli, Kleisli) 20 | import Data.Profunctor.Linear (Exchange, Market) 21 | import Data.Replicator.Linear (Replicator) 22 | import Data.Set.Mutable.Linear (Set) 23 | import Data.Unrestricted.Linear (AsMovable, MovableMonoid, Ur, UrT) 24 | import Data.V.Linear (V) 25 | import Data.Vector.Mutable.Linear (Vector) 26 | import Foreign.Marshal.Pure (Box, Pool) 27 | import Prelude.Linear.Generically (Generically, Generically1) 28 | import Streaming.Linear (Of, Stream) 29 | import Streaming.Prelude.Linear (Either3) 30 | import System.IO.Resource.Linear (RIO) 31 | 32 | -- import System.IO.Resource.Linear (Handle, RIO, UnsafeResource) 33 | 34 | deriveHasRep ''AsMovable 35 | deriveHasRep ''Box 36 | deriveHasRep ''CoKleisli 37 | deriveHasRep ''DArray 38 | deriveHasRep ''Data 39 | deriveHasRep ''Either3 40 | deriveHasRep ''Endo 41 | deriveHasRep ''Exchange 42 | deriveHasRep ''Generically 43 | deriveHasRep ''Generically1 44 | 45 | -- deriveHasRep ''Handle 46 | deriveHasRep ''HashMap 47 | deriveHasRep ''Kleisli 48 | deriveHasRep ''Market 49 | deriveHasRep ''MovableMonoid 50 | deriveHasRep ''NonLinear 51 | deriveHasRep ''Of 52 | deriveHasRep ''Optic_ 53 | deriveHasRep ''Peano 54 | deriveHasRep ''Pool 55 | deriveHasRep ''Pull.Array 56 | deriveHasRep ''RIO 57 | deriveHasRep ''ReaderT 58 | deriveHasRep ''Replicator 59 | deriveHasRep ''Set 60 | deriveHasRep ''StateT 61 | deriveHasRep ''Stream 62 | 63 | -- deriveHasRep ''UnsafeResource 64 | deriveHasRep ''Ur 65 | deriveHasRep ''UrT 66 | deriveHasRep ''V 67 | deriveHasRep ''Vector 68 | -------------------------------------------------------------------------------- /integrations/linear-base/integration/categorifier-linear-base-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-linear-base-integration 4 | version: 0.1 5 | description: Extensions to Conal's ConCat to improve plugin coverage. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.LinearBase.Client 43 | Categorifier.LinearBase.Integration 44 | other-modules: 45 | Paths_categorifier_linear_base_integration 46 | autogen-modules: 47 | Paths_categorifier_linear_base_integration 48 | build-depends: 49 | , categorifier-client 50 | , categorifier-duoids 51 | , categorifier-ghc 52 | , categorifier-plugin 53 | , containers ^>=0.6.2 54 | -- NB: This requires a newer release than `categorifier-plugin` because it relies on type class 55 | -- instances that didn’t exist prior to 0.3.0. 56 | , linear-base ^>=0.3.0 57 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 58 | , transformers ^>=0.5.6 || ^>=0.6.0 59 | -------------------------------------------------------------------------------- /integrations/unconcat/category/Categorifier/UnconCat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | {-# LANGUAGE DefaultSignatures #-} 3 | {-# LANGUAGE PolyKinds #-} 4 | 5 | -- | This module contains some category classes similar to those in @ConCat.Category@, 6 | -- but without the @Ok@ constraints. This can improve the performance significantly, 7 | -- since we don't need to build the dictionaries for the @Ok@ constraints. 8 | module Categorifier.UnconCat 9 | ( Category (..), 10 | AssociativePCat (..), 11 | ClosedCat (..), 12 | CoproductCat (..), 13 | MonoidalPCat (..), 14 | MProductCat, 15 | ProductCat (..), 16 | Coprod, 17 | Exp, 18 | Prod, 19 | (&&&), 20 | apply2, 21 | compose2, 22 | ) 23 | where 24 | 25 | import qualified Control.Arrow as P 26 | import Data.Kind (Type) 27 | import qualified Prelude as P 28 | 29 | type Coprod k = P.Either 30 | 31 | type Exp k = (->) 32 | 33 | type Prod k = (,) 34 | 35 | class Category (k :: Type -> Type -> Type) where 36 | id :: forall a. a `k` a 37 | infixr 9 . 38 | (.) :: forall b c a. (b `k` c) -> (a `k` b) -> (a `k` c) 39 | 40 | class (Category k) => AssociativePCat k where 41 | lassocP :: forall a b c. Prod k a (Prod k b c) `k` Prod k (Prod k a b) c 42 | default lassocP :: 43 | forall a b c. 44 | (MProductCat k) => 45 | Prod k a (Prod k b c) `k` Prod k (Prod k a b) c 46 | lassocP = second exl &&& (exr . exr) 47 | {-# INLINE lassocP #-} 48 | rassocP :: forall a b c. Prod k (Prod k a b) c `k` Prod k a (Prod k b c) 49 | default rassocP :: 50 | forall a b c. 51 | (MProductCat k) => 52 | Prod k (Prod k a b) c `k` Prod k a (Prod k b c) 53 | rassocP = (exl . exl) &&& first exr 54 | {-# INLINE rassocP #-} 55 | 56 | class (ProductCat k) => ClosedCat k where 57 | apply :: forall a b. Prod k (Exp k a b) a `k` b 58 | apply = uncurry id 59 | {-# INLINE apply #-} 60 | 61 | curry :: (Prod k a b `k` c) -> (a `k` Exp k b c) 62 | 63 | uncurry :: forall a b c. (a `k` Exp k b c) -> (Prod k a b `k` c) 64 | default uncurry :: 65 | forall a b c. 66 | (MonoidalPCat k) => 67 | (a `k` Exp k b c) -> 68 | (Prod k a b `k` c) 69 | uncurry g = apply . first g 70 | {-# INLINE uncurry #-} 71 | {-# MINIMAL curry, (apply | uncurry) #-} 72 | 73 | class (Category k) => CoproductCat k where 74 | inl :: forall a b. a `k` Coprod k a b 75 | inr :: forall a b. b `k` Coprod k a b 76 | jam :: forall a. Coprod k a a `k` a 77 | 78 | class (Category k) => MonoidalPCat k where 79 | (***) :: forall a b c d. (a `k` c) -> (b `k` d) -> (Prod k a b `k` Prod k c d) 80 | first :: forall a a' b. (a `k` a') -> (Prod k a b `k` Prod k a' b) 81 | first = (*** id) 82 | {-# INLINE first #-} 83 | second :: forall a b b'. (b `k` b') -> (Prod k a b `k` Prod k a b') 84 | second = (id ***) 85 | {-# INLINE second #-} 86 | 87 | type MProductCat k = (ProductCat k, MonoidalPCat k) 88 | 89 | class (Category k) => ProductCat k where 90 | exl :: forall a b. Prod k a b `k` a 91 | exr :: forall a b. Prod k a b `k` b 92 | dup :: a `k` Prod k a a 93 | 94 | (&&&) :: 95 | forall k a c d. 96 | (MProductCat k) => 97 | (a `k` c) -> 98 | (a `k` d) -> 99 | (a `k` Prod k c d) 100 | f &&& g = (f *** g) . dup 101 | {-# INLINE (&&&) #-} 102 | 103 | apply2 :: 104 | forall cat x a b. 105 | (ClosedCat cat, MonoidalPCat cat) => 106 | cat x (a -> b) -> 107 | cat x a -> 108 | cat x b 109 | apply2 f a = apply . (f &&& a) 110 | 111 | compose2 :: 112 | forall cat x b c a. 113 | (ClosedCat cat, MonoidalPCat cat) => 114 | cat x (b -> c) -> 115 | cat x (a -> b) -> 116 | cat x (a -> c) 117 | compose2 f g = curry (uncurry f . (exl &&& uncurry g)) 118 | 119 | ------------------------------------------------------------------------------ 120 | 121 | -- * (->) instances 122 | 123 | instance Category (->) where 124 | id = P.id 125 | (.) = (P..) 126 | 127 | instance AssociativePCat (->) where 128 | lassocP (a, (b, c)) = ((a, b), c) 129 | rassocP ((a, b), c) = (a, (b, c)) 130 | 131 | instance ClosedCat (->) where 132 | apply = P.uncurry (P.$) 133 | curry = P.curry 134 | uncurry = P.uncurry 135 | 136 | instance CoproductCat (->) where 137 | inl = P.Left 138 | inr = P.Right 139 | jam = P.id `P.either` P.id 140 | 141 | instance MonoidalPCat (->) where 142 | (***) = (P.***) 143 | first = P.first 144 | second = P.second 145 | 146 | instance ProductCat (->) where 147 | exl = P.fst 148 | exr = P.snd 149 | dup a = (a, a) 150 | -------------------------------------------------------------------------------- /integrations/unconcat/category/categorifier-unconcat-category.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-unconcat-category 4 | version: 0.1 5 | description: Unconstrained versions of Conal's ConCat classes. They can be used for categories 6 | that have an empty constraint (i.e., @`Ok` _ ~ `Yes1`@). These are generally much 7 | faster to categorify, because of the reduced need to solve constraints. If at some 8 | point the performance of ConCat is comparable to this, we should eliminate this. 9 | homepage: https://github.com/con-kitty/categorifier#readme 10 | bug-reports: https://github.com/con-kitty/categorifier/issues 11 | build-type: Simple 12 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 13 | 14 | source-repository head 15 | type: git 16 | location: https://github.com/con-kitty/categorifier 17 | 18 | common defaults 19 | ghc-options: 20 | -Wall 21 | build-depends: 22 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 23 | default-language: Haskell2010 24 | default-extensions: 25 | BangPatterns 26 | DeriveDataTypeable 27 | DeriveFoldable 28 | DeriveFunctor 29 | DeriveGeneric 30 | DeriveTraversable 31 | DerivingStrategies 32 | FlexibleContexts 33 | FlexibleInstances 34 | FunctionalDependencies 35 | InstanceSigs 36 | LambdaCase 37 | ScopedTypeVariables 38 | StandaloneDeriving 39 | TypeApplications 40 | TypeOperators 41 | 42 | library 43 | import: defaults 44 | exposed-modules: 45 | Categorifier.UnconCat 46 | other-modules: 47 | Paths_categorifier_unconcat_category 48 | autogen-modules: 49 | Paths_categorifier_unconcat_category 50 | ghc-options: 51 | -O2 52 | -------------------------------------------------------------------------------- /integrations/unconcat/integration-test/Categorifier/Test/UnconCat/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | 3 | -- | Orphans and re-exports combining our type class hierarchies with the plugin test categories. 4 | module Categorifier.Test.UnconCat.Instances 5 | ( Hask (..), 6 | Term (..), 7 | ) 8 | where 9 | 10 | import Categorifier.Test.ConCat.Instances (Hask (..), Term (..), binaryZero, unaryZero) 11 | import qualified Categorifier.UnconCat as UnconCat 12 | import Data.Bifunctor (Bifunctor (..)) 13 | 14 | ------------------------------------------------------------------------------ 15 | 16 | -- * Hask UnconCat instances 17 | 18 | instance UnconCat.Category Hask where 19 | id = Hask UnconCat.id 20 | Hask f . Hask g = Hask (f UnconCat.. g) 21 | 22 | instance UnconCat.AssociativePCat Hask 23 | 24 | instance UnconCat.ClosedCat Hask where 25 | apply = Hask (UnconCat.uncurry ($)) 26 | curry (Hask f) = Hask (curry f) 27 | uncurry (Hask f) = Hask (uncurry f) 28 | 29 | instance UnconCat.CoproductCat Hask where 30 | inl = Hask Left 31 | inr = Hask Right 32 | jam = 33 | Hask 34 | ( \case 35 | Left x -> x 36 | Right y -> y 37 | ) 38 | 39 | instance UnconCat.MonoidalPCat Hask where 40 | Hask f *** Hask g = Hask (bimap f g) 41 | 42 | instance UnconCat.ProductCat Hask where 43 | exl = Hask fst 44 | exr = Hask snd 45 | dup = Hask (\x -> (x, x)) 46 | 47 | ------------------------------------------------------------------------------ 48 | 49 | -- * Term UnconCat instances 50 | 51 | instance UnconCat.Category Term where 52 | id = ZeroId 53 | (.) = binaryZero 54 | 55 | instance UnconCat.AssociativePCat Term 56 | 57 | instance UnconCat.ClosedCat Term where 58 | apply = ZeroId 59 | curry = unaryZero 60 | uncurry = unaryZero 61 | 62 | instance UnconCat.CoproductCat Term where 63 | inl = ZeroId 64 | inr = ZeroId 65 | jam = ZeroId 66 | 67 | instance UnconCat.MonoidalPCat Term where 68 | (***) = binaryZero 69 | 70 | instance UnconCat.ProductCat Term where 71 | exl = ZeroId 72 | exr = ZeroId 73 | dup = ZeroId 74 | -------------------------------------------------------------------------------- /integrations/unconcat/integration-test/categorifier-unconcat-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-unconcat-integration-test 4 | version: 0.1 5 | description: Plugin using our extensions to Conal's ConCat functions. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | build-depends: 17 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 18 | , categorifier-concat-integration-test 19 | , categorifier-plugin-test 20 | , categorifier-unconcat-category 21 | , concat-classes 22 | ghc-options: 23 | -Wall 24 | default-language: Haskell2010 25 | default-extensions: 26 | BangPatterns 27 | DeriveDataTypeable 28 | DeriveFoldable 29 | DeriveFunctor 30 | DeriveGeneric 31 | DeriveTraversable 32 | DerivingStrategies 33 | FlexibleContexts 34 | FlexibleInstances 35 | FunctionalDependencies 36 | InstanceSigs 37 | LambdaCase 38 | ScopedTypeVariables 39 | StandaloneDeriving 40 | TypeApplications 41 | TypeOperators 42 | 43 | library 44 | import: defaults 45 | exposed-modules: 46 | Categorifier.Test.UnconCat.Instances 47 | 48 | common hierarchy-tests 49 | import: defaults 50 | hs-source-dirs: test 51 | ghc-options: 52 | -- make it possible to inline almost anything 53 | -fexpose-all-unfoldings 54 | -- ensure unfoldings are available 55 | -fno-omit-interface-pragmas 56 | -fplugin Categorifier 57 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.UnconCat.hierarchy 58 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.functionHierarchy 59 | build-depends: 60 | , adjunctions ^>=4.4 61 | , categorifier-category 62 | , categorifier-client 63 | , categorifier-concat-integration 64 | , categorifier-hedgehog 65 | , categorifier-plugin 66 | , categorifier-unconcat-integration 67 | , categorifier-unconcat-integration-test 68 | , concat-examples 69 | , either ^>=5.0.1 70 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 71 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 72 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 73 | 74 | test-suite unconcat-hierarchy 75 | import: hierarchy-tests 76 | type: exitcode-stdio-1.0 77 | main-is: UnconCat/Main.hs 78 | ghc-options: 79 | -O0 80 | 81 | test-suite unconcat-hierarchy-optimized 82 | import: hierarchy-tests 83 | type: exitcode-stdio-1.0 84 | main-is: UnconCat/Main.hs 85 | ghc-options: 86 | -O2 87 | -fignore-interface-pragmas 88 | -------------------------------------------------------------------------------- /integrations/unconcat/integration/Categorifier/Hierarchy/UnconCat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ApplicativeDo #-} 2 | {-# LANGUAGE StrictData #-} 3 | {-# LANGUAGE TemplateHaskellQuotes #-} 4 | 5 | -- | Defines various mappings between categorical representations and the plugin, allowing us to 6 | -- support transformations against different type class hierarchies. 7 | module Categorifier.Hierarchy.UnconCat 8 | ( hierarchy, 9 | ) 10 | where 11 | 12 | import Categorifier.Core.Types (CategoryStack, Lookup) 13 | import Categorifier.Hierarchy 14 | ( Hierarchy (..), 15 | emptyHierarchy, 16 | identifier, 17 | mkFunctionApps, 18 | mkMethodApps, 19 | ) 20 | import qualified Categorifier.UnconCat 21 | 22 | hierarchy :: Lookup (Hierarchy CategoryStack) 23 | hierarchy = do 24 | kapplyV <- 25 | pure <$> do 26 | fn <- identifier 'Categorifier.UnconCat.apply 27 | pure (\onDict cat a b -> mkMethodApps onDict fn [cat] [a, b] []) 28 | kapply2V <- 29 | pure <$> do 30 | fn <- identifier 'Categorifier.UnconCat.apply2 31 | pure (\onDict cat x a b f g -> mkFunctionApps onDict fn [cat, x, a, b] [f, g]) 32 | kcomposeV <- 33 | pure <$> do 34 | fn <- identifier '(Categorifier.UnconCat..) 35 | pure (\onDict cat a b c -> mkMethodApps onDict fn [cat] [b, c, a] []) 36 | kcompose2V <- 37 | pure <$> do 38 | fn <- identifier 'Categorifier.UnconCat.compose2 39 | pure (\onDict cat x b c a f g -> mkFunctionApps onDict fn [cat, x, b, c, a] [f, g]) 40 | kcurryV <- 41 | pure <$> do 42 | fn <- identifier 'Categorifier.UnconCat.curry 43 | pure (\onDict cat a b c -> mkMethodApps onDict fn [cat] [a, b, c] []) 44 | kexlV <- 45 | pure <$> do 46 | fn <- identifier 'Categorifier.UnconCat.exl 47 | pure (\onDict cat a b -> mkMethodApps onDict fn [cat] [a, b] []) 48 | kexrV <- 49 | pure <$> do 50 | fn <- identifier 'Categorifier.UnconCat.exr 51 | pure (\onDict cat a b -> mkMethodApps onDict fn [cat] [a, b] []) 52 | kforkV <- 53 | pure <$> do 54 | fn <- identifier '(Categorifier.UnconCat.&&&) 55 | pure (\onDict cat a b c -> mkFunctionApps onDict fn [cat, a, b, c] []) 56 | kidV <- 57 | pure <$> do 58 | fn <- identifier 'Categorifier.UnconCat.id 59 | pure (\onDict cat a -> mkMethodApps onDict fn [cat] [a] []) 60 | kinlV <- 61 | pure <$> do 62 | fn <- identifier 'Categorifier.UnconCat.inl 63 | pure (\onDict cat a b -> mkMethodApps onDict fn [cat] [a, b] []) 64 | kinrV <- 65 | pure <$> do 66 | fn <- identifier 'Categorifier.UnconCat.inr 67 | pure (\onDict cat a b -> mkMethodApps onDict fn [cat] [a, b] []) 68 | klassocV <- 69 | pure <$> do 70 | fn <- identifier 'Categorifier.UnconCat.lassocP 71 | pure (\onDict cat a b c -> mkMethodApps onDict fn [cat] [a, b, c] []) 72 | krassocV <- 73 | pure <$> do 74 | fn <- identifier 'Categorifier.UnconCat.rassocP 75 | pure (\onDict cat a b c -> mkMethodApps onDict fn [cat] [a, b, c] []) 76 | kuncurryV <- 77 | pure <$> do 78 | fn <- identifier 'Categorifier.UnconCat.uncurry 79 | pure (\onDict cat a b c -> mkMethodApps onDict fn [cat] [a, b, c] []) 80 | pure 81 | emptyHierarchy 82 | { applyV = kapplyV, 83 | apply2V = kapply2V, 84 | composeV = kcomposeV, 85 | compose2V = kcompose2V, 86 | curryV = kcurryV, 87 | exlV = kexlV, 88 | exrV = kexrV, 89 | forkV = kforkV, 90 | idV = kidV, 91 | inlV = kinlV, 92 | inrV = kinrV, 93 | lassocV = klassocV, 94 | rassocV = krassocV, 95 | uncurryV = kuncurryV 96 | } 97 | -------------------------------------------------------------------------------- /integrations/unconcat/integration/categorifier-unconcat-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-unconcat-integration 4 | version: 0.1 5 | description: Extensions to Conal's ConCat to improve plugin coverage. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Hierarchy.UnconCat 43 | other-modules: 44 | Paths_categorifier_unconcat_integration 45 | autogen-modules: 46 | Paths_categorifier_unconcat_integration 47 | build-depends: 48 | , bytestring ^>=0.10.9 || ^>=0.11.0 49 | , categorifier-duoids 50 | , categorifier-plugin 51 | , categorifier-unconcat-category 52 | , ghc ^>=8.8.1 || ^>=8.10.1 || ^>=9.0.1 || ^>=9.2.1 53 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 54 | , transformers ^>=0.5.6 || ^>=0.6.0 55 | -------------------------------------------------------------------------------- /integrations/vec/integration-test/Categorifier/Test/Vec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | -- To avoid having to specify massive HList types. 3 | {-# LANGUAGE PartialTypeSignatures #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | -- To avoid having to specify massive HList types. 6 | {-# OPTIONS_GHC -Wno-partial-type-signatures #-} 7 | 8 | module Categorifier.Test.Vec 9 | ( testTerms, 10 | ) 11 | where 12 | 13 | import Categorifier.Test.HList (HMap1 (..)) 14 | import Categorifier.Test.TH (mkBinaryTestConfig, mkUnaryTestConfig) 15 | import Categorifier.Test.Tests (TestTerms, insertTest) 16 | import Data.Fin (Fin) 17 | import Data.Proxy (Proxy (..)) 18 | import qualified Data.Type.Nat as Nat 19 | import Data.Vec.Lazy (Vec (..)) 20 | import qualified Data.Vec.Lazy as Vec 21 | 22 | testTerms :: TestTerms _ 23 | testTerms = 24 | insertTest 25 | (Proxy @"BindVec") 26 | mkBinaryTestConfig 27 | (\a -> ([t|Vec Nat.Nat9 $a|], [t|($a -> Vec Nat.Nat9 $a) -> Vec Nat.Nat9 $a|])) 28 | [|Vec.bind|] 29 | . insertTest 30 | (Proxy @"IndexVec") 31 | mkBinaryTestConfig 32 | (\a -> ([t|Vec Nat.Nat9 $a|], [t|Fin Nat.Nat9 -> $a|])) 33 | [|(Vec.!)|] 34 | . insertTest 35 | (Proxy @"MapVec") 36 | mkUnaryTestConfig 37 | (\a -> ([t|Vec Nat.Nat9 $a|], [t|Vec Nat.Nat9 $a|])) 38 | [|Vec.map id|] 39 | . insertTest (Proxy @"SumVec") mkUnaryTestConfig (\a -> ([t|Vec Nat.Nat9 $a|], a)) [|Vec.sum|] 40 | . insertTest 41 | (Proxy @"TabulateVec") 42 | mkUnaryTestConfig 43 | (\a -> ([t|Fin Nat.Nat9 -> $a|], [t|Vec Nat.Nat9 $a|])) 44 | [|Vec.tabulate|] 45 | . insertTest 46 | (Proxy @"TraverseVec") 47 | mkUnaryTestConfig 48 | (\(f, a) -> ([t|Vec Nat.Nat9 $a|], [t|$f (Vec Nat.Nat9 $a)|])) 49 | [|Vec.traverse pure|] 50 | $ HEmpty1 51 | -------------------------------------------------------------------------------- /integrations/vec/integration-test/Categorifier/Test/Vec/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | 3 | module Categorifier.Test.Vec.Instances 4 | ( module Categorifier.Test.Hask, 5 | module Categorifier.Test.Term, 6 | ) 7 | where 8 | 9 | import Categorifier.Test.Hask 10 | import Categorifier.Test.Term 11 | import Data.Pointed (Pointed (..)) 12 | import qualified Data.Type.Nat as Nat 13 | import Data.Vec.Lazy (Vec) 14 | 15 | instance (Nat.SNatI n) => Pointed (Vec n) where 16 | point = pure 17 | -------------------------------------------------------------------------------- /integrations/vec/integration-test/categorifier-vec-integration-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-vec-integration-test 4 | version: 0.1 5 | description: Test utilities for categorifier's vec integration. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | , categorifier-plugin-test 21 | , fin ^>=0.1.1 || ^>=0.2 || ^>=0.3 22 | , vec ^>=0.3 || ^>=0.4 || ^>=0.5 23 | default-language: Haskell2010 24 | default-extensions: 25 | BangPatterns 26 | DeriveDataTypeable 27 | DeriveFoldable 28 | DeriveFunctor 29 | DeriveGeneric 30 | DeriveTraversable 31 | DerivingStrategies 32 | FlexibleContexts 33 | FlexibleInstances 34 | FunctionalDependencies 35 | InstanceSigs 36 | LambdaCase 37 | ScopedTypeVariables 38 | StandaloneDeriving 39 | TypeApplications 40 | TypeOperators 41 | 42 | library 43 | import: defaults 44 | exposed-modules: 45 | Categorifier.Test.Vec 46 | Categorifier.Test.Vec.Instances 47 | build-depends: 48 | , pointed ^>=5.0.0 49 | 50 | common hierarchy-tests 51 | import: defaults 52 | hs-source-dirs: test 53 | ghc-options: 54 | -- make it possible to inline almost anything 55 | -fexpose-all-unfoldings 56 | -- ensure unfoldings are available 57 | -fno-omit-interface-pragmas 58 | -fplugin Categorifier 59 | -- Using the ConCat hierarchy, because it's the only one that supports `traverse` (and probably 60 | -- other things) 61 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCat.functionHierarchy 62 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.ConCatExtensions.hierarchy 63 | -fplugin-opt Categorifier:lookup:Categorifier.Vec.Integration.symbolLookup 64 | -fplugin-opt Categorifier:maker-map:Categorifier.Vec.Integration.makerMapFun 65 | -fplugin-opt Categorifier:maker-map:Categorifier.Core.MakerMap.baseMakerMapFun 66 | build-depends: 67 | , categorifier-concat-integration 68 | , categorifier-concat-extensions-category 69 | , categorifier-concat-extensions-integration 70 | , categorifier-concat-extensions-integration-test 71 | , categorifier-category 72 | , categorifier-client 73 | , categorifier-hedgehog 74 | , categorifier-plugin 75 | , categorifier-plugin-test 76 | , categorifier-vec-integration 77 | , categorifier-vec-integration-test 78 | , concat-classes 79 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 80 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 81 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 82 | 83 | test-suite vec-hierarchy 84 | import: hierarchy-tests 85 | type: exitcode-stdio-1.0 86 | main-is: Vec/Main.hs 87 | ghc-options: 88 | -O0 89 | 90 | test-suite vec-hierarchy-optimized 91 | import: hierarchy-tests 92 | type: exitcode-stdio-1.0 93 | main-is: Vec/Main.hs 94 | ghc-options: 95 | -O2 96 | -fignore-interface-pragmas 97 | -------------------------------------------------------------------------------- /integrations/vec/integration-test/test/Vec/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE MultiWayIf #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE TupleSections #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | -- To avoid turning @if then else@ into `ifThenElse`. 8 | {-# LANGUAGE NoRebindableSyntax #-} 9 | 10 | -- | See @Test/Cat/ConCat/Main.hs@ for copious notes on the testing situation here. 11 | module Main 12 | ( main, 13 | ) 14 | where 15 | 16 | import Categorifier.Hedgehog (genFloating, genIntegralBounded) 17 | import Categorifier.Test.ConCatExtensions.Instances (Hask (..), Term) 18 | import Categorifier.Test.HList (HMap1 (..)) 19 | import Categorifier.Test.Tests 20 | ( TestCases (..), 21 | TestCategory (..), 22 | TestStrategy (..), 23 | mkTestTerms, 24 | ) 25 | import qualified Categorifier.Test.Vec as Vec 26 | import Categorifier.Test.Vec.Instances () 27 | import Data.Bool (bool) 28 | import Data.Functor.Identity (Identity (..)) 29 | import Data.Proxy (Proxy (..)) 30 | import qualified Data.Type.Nat as Nat 31 | import Data.Vec.Lazy (Vec (..)) 32 | import qualified Data.Vec.Lazy as Vec 33 | import GHC.Word (Word8) 34 | import System.Exit (exitFailure, exitSuccess) 35 | 36 | -- For @NoRebindableSyntax@ 37 | {-# ANN module ("HLint: ignore Avoid restricted integration" :: String) #-} 38 | 39 | mkTestTerms 40 | Vec.testTerms 41 | -- name type prefix strategy 42 | [ TestCategory ''Term [t|Term|] "term" CheckCompileOnly, 43 | TestCategory ''(->) [t|(->)|] "plainArrow" $ ComputeFromInput [|id|], 44 | TestCategory ''Hask [t|Hask|] "hask" (ComputeFromInput [|runHask|]) 45 | ] 46 | . HInsert1 47 | (Proxy @"BindVec") 48 | ( TestCases 49 | ( const 50 | [ ( [t|Double|], 51 | pure ([|fmap (,pure) . sequenceA $ pure genFloating|], [|show . fst|]) 52 | ) 53 | ] 54 | ) 55 | ) 56 | . HInsert1 57 | (Proxy @"IndexVec") 58 | ( TestCases 59 | ( const 60 | [ ( [t|Word8|], 61 | pure 62 | ( [|(,) <$> sequenceA (Vec.tabulate $ const genIntegralBounded) <*> genIntegralBounded|], 63 | [|show|] 64 | ) 65 | ) 66 | ] 67 | ) 68 | ) 69 | . HInsert1 70 | (Proxy @"MapVec") 71 | (TestCases (const [([t|Double|], pure ([|sequenceA $ pure genFloating|], [|show|]))])) 72 | . HInsert1 73 | (Proxy @"SumVec") 74 | (TestCases (const [([t|Double|], pure ([|sequenceA $ pure genFloating|], [|show|]))])) 75 | . HInsert1 76 | (Proxy @"TabulateVec") 77 | ( TestCases 78 | ( const 79 | [ ( [t|Word8|], 80 | pure 81 | ( [|fmap (Vec.!) . sequenceA $ pure genIntegralBounded|], 82 | [|show . (<$> Vec.universe)|] 83 | ) 84 | ) 85 | ] 86 | ) 87 | ) 88 | . HInsert1 89 | (Proxy @"TraverseVec") 90 | ( TestCases 91 | ( const 92 | [ ( ([t|Identity|], [t|Word8|]), 93 | pure ([|sequenceA (pure genIntegralBounded)|], [|show|]) 94 | ), 95 | ( ([t|Vec Nat.Nat9|], [t|Word8|]), 96 | pure ([|sequenceA (pure genIntegralBounded)|], [|show|]) 97 | ) 98 | ] 99 | ) 100 | ) 101 | $ HEmpty1 102 | 103 | main :: IO () 104 | main = bool exitFailure exitSuccess . and =<< allTestTerms 105 | -------------------------------------------------------------------------------- /integrations/vec/integration/Categorifier/Vec/Client.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | {-# OPTIONS_GHC -Wno-orphans #-} 5 | 6 | module Categorifier.Vec.Client 7 | ( HasRep (..), 8 | Rep, 9 | deriveHasRep, 10 | ) 11 | where 12 | 13 | import Categorifier.Client (HasRep (..), Rep, deriveHasRep) 14 | import Data.Vec.Lazy (Vec (..)) 15 | 16 | deriveHasRep ''Vec 17 | -------------------------------------------------------------------------------- /integrations/vec/integration/Categorifier/Vec/Integration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ApplicativeDo #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE PatternSynonyms #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE StrictData #-} 6 | {-# LANGUAGE TemplateHaskellQuotes #-} 7 | {-# LANGUAGE TupleSections #-} 8 | {-# LANGUAGE ViewPatterns #-} 9 | 10 | module Categorifier.Vec.Integration 11 | ( symbolLookup, 12 | makerMapFun, 13 | ) 14 | where 15 | 16 | import Categorifier.Core.MakerMap 17 | ( MakerMapFun, 18 | SymbolLookup (..), 19 | applyEnrichedCat', 20 | makeLookupMap, 21 | makeMaker1, 22 | makeMaker2, 23 | ) 24 | import Categorifier.Core.Makers (Makers (..)) 25 | import Categorifier.Core.Types (Lookup) 26 | import Categorifier.Duoidal (joinD, (<*\>), (=<\<)) 27 | import qualified Categorifier.GHC.Builtin as Plugins 28 | import qualified Categorifier.GHC.Core as Plugins 29 | import qualified Data.Map as Map 30 | import qualified Data.Vec.Lazy 31 | import Prelude hiding (lookup) 32 | 33 | symbolLookup :: Lookup SymbolLookup 34 | symbolLookup = makeLookupMap [''Data.Vec.Lazy.Vec] 35 | 36 | makerMapFun :: MakerMapFun 37 | makerMapFun 38 | symLookup 39 | _dflags 40 | _logger 41 | m@Makers {..} 42 | n 43 | _target 44 | expr 45 | _cat 46 | _var 47 | _args 48 | _modu 49 | _categorifyFun 50 | categorifyLambda = 51 | Map.fromListWith 52 | const 53 | [ ( '(Data.Vec.Lazy.!), 54 | \case 55 | Plugins.Type n' : Plugins.Type a : rest -> do 56 | vec <- Map.lookup ''Data.Vec.Lazy.Vec (tyConLookup symLookup) 57 | pure $ maker1 rest =<\< mkIndex (Plugins.mkTyConApp vec [n']) a 58 | _ -> Nothing 59 | ), 60 | ( 'Data.Vec.Lazy.bind, 61 | \case 62 | Plugins.Type n' : Plugins.Type a : Plugins.Type b : rest -> do 63 | vec <- Map.lookup ''Data.Vec.Lazy.Vec (tyConLookup symLookup) 64 | pure $ maker2 rest =<\< mkBind (Plugins.mkTyConApp vec [n']) a b 65 | _ -> Nothing 66 | ), 67 | ( 'Data.Vec.Lazy.map, 68 | \case 69 | Plugins.Type a : Plugins.Type b : Plugins.Type n' : u : rest -> do 70 | -- from: (\n -> map {{u}}) :: n -> [a] -> [b] 71 | -- to: curry (map (uncurry (categorifyLambda n {{u}})) . strength) 72 | -- :: n `k` ([a] -> [b]) 73 | vec <- Map.lookup ''Data.Vec.Lazy.Vec (tyConLookup symLookup) 74 | let f = Plugins.mkTyConApp vec [n'] 75 | pure . joinD $ 76 | applyEnriched' [u] rest 77 | <$> mkMap f (Plugins.mkBoxedTupleTy [Plugins.varType n, a]) b 78 | <*\> mkStrength f (Plugins.varType n) a 79 | _ -> Nothing 80 | ), 81 | ( 'Data.Vec.Lazy.sum, 82 | \case 83 | Plugins.Type a : Plugins.Type n' : _num : rest -> do 84 | vec <- Map.lookup ''Data.Vec.Lazy.Vec (tyConLookup symLookup) 85 | pure $ maker1 rest =<\< mkSum (Plugins.mkTyConApp vec [n']) a 86 | _ -> Nothing 87 | ), 88 | ( 'Data.Vec.Lazy.tabulate, 89 | \case 90 | Plugins.Type n' : Plugins.Type a : _snati : rest -> do 91 | vec <- Map.lookup ''Data.Vec.Lazy.Vec (tyConLookup symLookup) 92 | pure $ maker1 rest =<\< mkTabulate (Plugins.mkTyConApp vec [n']) a 93 | _ -> Nothing 94 | ), 95 | ( 'Data.Vec.Lazy.traverse, 96 | \case 97 | Plugins.Type n' : Plugins.Type f : Plugins.Type a : Plugins.Type b 98 | : _applicative 99 | : u 100 | : rest -> do 101 | vec <- Map.lookup ''Data.Vec.Lazy.Vec (tyConLookup symLookup) 102 | let t = Plugins.mkTyConApp vec [n'] 103 | pure . joinD $ 104 | applyEnriched' [u] rest 105 | <$> mkTraverse t f (Plugins.mkBoxedTupleTy [Plugins.varType n, a]) b 106 | <*\> mkStrength t (Plugins.varType n) a 107 | _ -> Nothing 108 | ) 109 | ] 110 | where 111 | applyEnriched' = applyEnrichedCat' m categorifyLambda 112 | maker1 = makeMaker1 m categorifyLambda 113 | maker2 = makeMaker2 m categorifyLambda expr 114 | -------------------------------------------------------------------------------- /integrations/vec/integration/categorifier-vec-integration.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-vec-integration 4 | version: 0.1 5 | description: Extensions to Conal's ConCat to improve plugin coverage. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.Vec.Client 43 | Categorifier.Vec.Integration 44 | other-modules: 45 | Paths_categorifier_vec_integration 46 | autogen-modules: 47 | Paths_categorifier_vec_integration 48 | build-depends: 49 | , categorifier-client 50 | , categorifier-duoids 51 | , categorifier-ghc 52 | , categorifier-plugin 53 | , containers ^>=0.6.2 54 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 55 | , transformers ^>=0.5.6 || ^>=0.6.0 56 | , vec ^>=0.3 || ^>=0.4 || ^>=0.5 57 | -------------------------------------------------------------------------------- /plugin-test/Categorifier/Test/Data.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | 5 | module Categorifier.Test.Data 6 | ( One (..), 7 | Oneof (..), 8 | Pair (..), 9 | ) 10 | where 11 | 12 | import qualified Categorifier.Client as Client 13 | import Data.Distributive (Distributive (..)) 14 | import Data.Functor.Rep (Representable) 15 | import GHC.Generics (Generic, Generic1) 16 | 17 | -- For DeriveAnyClass 18 | {-# ANN module "HLint: ignore Avoid restricted integration" #-} 19 | 20 | {-# ANN module "HLint: ignore Use newtype instead of data" #-} 21 | 22 | -- | Same as @Identity@, except defined using @data@ rather than @newtype@. This makes it 23 | -- easier to test some of the specialized methods, e.g., @$fRepresentableOne_$ctabulate@. 24 | -- Using @Identity@ we'd get @$fRepresentableIdentity1@. 25 | data One a = One a 26 | deriving 27 | ( Eq, 28 | Ord, 29 | Show, 30 | Functor, 31 | Traversable, 32 | Foldable, 33 | Generic, 34 | Generic1, 35 | Representable 36 | ) 37 | 38 | instance Distributive One where 39 | distribute = One . fmap (\(One a) -> a) 40 | 41 | Client.deriveHasRep ''One 42 | 43 | data Pair a = Pair a a 44 | deriving (Generic, Eq, Ord, Show, Functor) 45 | 46 | instance Applicative Pair where 47 | pure x = Pair x x 48 | Pair f f' <*> Pair x x' = Pair (f x) (f' x') 49 | 50 | Client.deriveHasRep ''Pair 51 | 52 | data Oneof a 53 | = Perhaps a 54 | | Or a 55 | deriving (Generic, Eq, Ord, Show, Functor) 56 | 57 | Client.deriveHasRep ''Oneof 58 | -------------------------------------------------------------------------------- /plugin-test/Categorifier/Test/HList.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE PolyKinds #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | 7 | module Categorifier.Test.HList 8 | ( HList1 (..), 9 | HMap1 (..), 10 | append, 11 | appendMap, 12 | lowerWith, 13 | map1, 14 | zipWith, 15 | zipLowerWith, 16 | zipMapLowerWith, 17 | ) 18 | where 19 | 20 | import Data.Kind (Type) 21 | import Data.Nat (Nat (..)) 22 | import Data.Proxy (Proxy (..)) 23 | import Data.Vec.Lazy (Vec (..)) 24 | import Prelude hiding (lookup, zipWith) 25 | 26 | -- | An @HList@ where each term is wrapped in the same functor. 27 | -- 28 | -- - @`HList1` `Data.Functor.Identity.Identity` ~ Data.HList.HList.HList@ 29 | -- - @`HList1` (`Data.Functor.Const.Const` a) l ~ `Vec` (`Length` l) a@ 30 | data HList1 (f :: k -> Type) (l :: [k]) where 31 | HNil1 :: HList1 f '[] 32 | HCons1 :: f e -> HList1 f l -> HList1 f (e ': l) 33 | 34 | type family Append (a :: [k]) (b :: [k]) :: [k] where 35 | Append '[] b = b 36 | Append (a ': as) b = a ': Append as b 37 | 38 | type family Length (a :: [k]) :: Nat where 39 | Length '[] = 'Z 40 | Length (_h ': t) = 'S (Length t) 41 | 42 | append :: HList1 f l -> HList1 f m -> HList1 f (Append l m) 43 | append HNil1 = id 44 | append (HCons1 h t) = HCons1 h . append t 45 | 46 | lowerWith :: (forall a. f a -> c) -> HList1 f l -> Vec (Length l) c 47 | lowerWith fn = \case 48 | HNil1 -> VNil 49 | (HCons1 h t) -> fn h ::: lowerWith fn t 50 | 51 | map1 :: (forall a. f a -> g a) -> HList1 f l -> HList1 g l 52 | map1 fn = \case 53 | HNil1 -> HNil1 54 | (HCons1 h t) -> HCons1 (fn h) $ map1 fn t 55 | 56 | zipWith :: (forall a. f a -> g a -> h a) -> HList1 f l -> HList1 g l -> HList1 h l 57 | zipWith _ HNil1 HNil1 = HNil1 58 | zipWith fn (HCons1 hf tf) (HCons1 hg tg) = HCons1 (fn hf hg) $ zipWith fn tf tg 59 | 60 | -- | Should be equivalent to 61 | -- @(`lowerWith` `Data.Functor.Const.getConst` .) . `zipWith` (`Data.Functor.Const.Const` . fn)@, 62 | -- but more efficient. 63 | zipLowerWith :: (forall a. f a -> g a -> c) -> HList1 f l -> HList1 g l -> Vec (Length l) c 64 | zipLowerWith _ HNil1 HNil1 = VNil 65 | zipLowerWith fn (HCons1 hf tf) (HCons1 hg tg) = fn hf hg ::: zipLowerWith fn tf tg 66 | 67 | data HMap1 (f :: v -> Type) (l :: [(k, v)]) where 68 | HEmpty1 :: HMap1 f '[] 69 | HInsert1 :: Proxy k -> f e -> HMap1 f l -> HMap1 f ('(k, e) ': l) 70 | 71 | zipMapLowerWith :: (forall a. f a -> g a -> c) -> HMap1 f l -> HMap1 g l -> Vec (Length l) c 72 | zipMapLowerWith _ HEmpty1 HEmpty1 = VNil 73 | zipMapLowerWith f (HInsert1 Proxy fe t) (HInsert1 Proxy ge u) = f fe ge ::: zipMapLowerWith f t u 74 | 75 | appendMap :: HMap1 f l -> HMap1 f m -> HMap1 f (Append l m) 76 | appendMap HEmpty1 = id 77 | appendMap (HInsert1 k v t) = HInsert1 k v . appendMap t 78 | -------------------------------------------------------------------------------- /plugin-test/Categorifier/Test/Hask.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | {-# LANGUAGE UndecidableInstances #-} 4 | 5 | module Categorifier.Test.Hask 6 | ( Hask (..), 7 | ) 8 | where 9 | 10 | import Categorifier.Category (ReferenceCat (..), RepCat (..), UnsafeCoerceCat (..)) 11 | import qualified Categorifier.Client as Client 12 | import qualified Control.Arrow as Base 13 | import qualified Control.Category as Base 14 | 15 | -- | A trivial wrapper around __Hask__ for testing purposes. 16 | data Hask a b = Hask {runHask :: a -> b} 17 | {-# ANN Hask "Hlint: ignore Use newtype instead of data" #-} 18 | 19 | instance Base.Category Hask where 20 | id = Hask Base.id 21 | 22 | Hask f . Hask g = Hask (f Base.. g) 23 | 24 | instance Base.Arrow Hask where 25 | arr = Hask 26 | 27 | first (Hask f) = Hask (Base.first f) 28 | 29 | instance Base.ArrowApply Hask where 30 | app = Hask (Base.app . Base.first runHask) 31 | 32 | instance Base.ArrowChoice Hask where 33 | Hask f +++ Hask g = Hask (f Base.+++ g) 34 | 35 | instance Base.ArrowLoop Hask where 36 | loop (Hask f) = Hask (Base.loop f) 37 | 38 | instance (Client.HasRep a, r ~ Client.Rep a) => RepCat Hask a r where 39 | abstC = Hask Client.abst 40 | reprC = Hask Client.repr 41 | 42 | instance ReferenceCat Hask a b 43 | 44 | instance UnsafeCoerceCat Hask a b where 45 | unsafeCoerceK = Hask unsafeCoerceK 46 | -------------------------------------------------------------------------------- /plugin-test/Categorifier/Test/Term.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | 3 | module Categorifier.Test.Term 4 | ( Term (..), 5 | binaryZero, 6 | unaryZero, 7 | ) 8 | where 9 | 10 | import Categorifier.Category (RepCat (..), UnsafeCoerceCat (..)) 11 | import qualified Categorifier.Client as Client 12 | import qualified Control.Arrow as Base 13 | import qualified Control.Category as Base 14 | 15 | -- | The terminal object in __Cat__ -- a category with only a single object (up to unique 16 | -- isomorphism), whose only arrow is its identity. 17 | data Term a b = ZeroId 18 | deriving (Show) 19 | 20 | unaryZero :: Term a b -> Term c d 21 | unaryZero ZeroId = ZeroId 22 | 23 | binaryZero :: Term a b -> Term c d -> Term e f 24 | binaryZero ZeroId ZeroId = ZeroId 25 | 26 | instance Base.Category Term where 27 | id = ZeroId 28 | 29 | (.) = binaryZero 30 | 31 | instance Base.Arrow Term where 32 | arr _ = ZeroId 33 | 34 | first = unaryZero 35 | 36 | instance Base.ArrowChoice Term where 37 | (+++) = binaryZero 38 | 39 | instance Base.ArrowApply Term where 40 | app = ZeroId 41 | 42 | instance Base.ArrowLoop Term where 43 | loop = unaryZero 44 | 45 | instance (Client.HasRep a, r ~ Client.Rep a) => RepCat Term a r where 46 | abstC = ZeroId 47 | reprC = ZeroId 48 | 49 | instance UnsafeCoerceCat Term a b where 50 | unsafeCoerceK = ZeroId 51 | -------------------------------------------------------------------------------- /plugin-test/categorifier-plugin-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-plugin-test 4 | version: 0.1 5 | description: Framework for testing integration to the plugin. 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , adjunctions ^>=4.4 20 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 21 | , categorifier-category 22 | , categorifier-client 23 | , categorifier-common 24 | , categorifier-hedgehog 25 | , categorifier-plugin 26 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 27 | , hedgehog ^>=1.0.3 || ^>=1.1 || ^>=1.2 28 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 29 | default-language: Haskell2010 30 | default-extensions: 31 | BangPatterns 32 | DeriveDataTypeable 33 | DeriveFoldable 34 | DeriveFunctor 35 | DeriveGeneric 36 | DeriveTraversable 37 | DerivingStrategies 38 | FlexibleContexts 39 | FlexibleInstances 40 | FunctionalDependencies 41 | InstanceSigs 42 | LambdaCase 43 | ScopedTypeVariables 44 | StandaloneDeriving 45 | TypeApplications 46 | TypeOperators 47 | 48 | library 49 | import: defaults 50 | exposed-modules: 51 | Categorifier.Test.Data 52 | Categorifier.Test.HList 53 | Categorifier.Test.Hask 54 | Categorifier.Test.Term 55 | Categorifier.Test.Tests 56 | Categorifier.Test.TH 57 | other-modules: 58 | Paths_categorifier_plugin_test 59 | autogen-modules: 60 | Paths_categorifier_plugin_test 61 | ghc-options: 62 | -O2 63 | build-depends: 64 | , PyF ^>=0.9.0 || ^>=0.10.0 || ^>=0.11.0 65 | , distributive ^>=0.6.2 66 | , extra ^>=1.7.8 67 | , fin ^>=0.1.1 || ^>=0.2 || ^>=0.3 68 | , text ^>=1.2.4 69 | , vec ^>=0.3 || ^>=0.4 || ^>=0.5 70 | if impl(ghc >= 9.0.0) 71 | build-depends: linear-base ^>=0.2.0 || ^>=0.3.0 72 | 73 | common tests 74 | import: defaults 75 | hs-source-dirs: test 76 | build-depends: 77 | , categorifier-plugin-test 78 | , either ^>=5.0.1 79 | ghc-options: 80 | -- make it possible to inline almost anything 81 | -fexpose-all-unfoldings 82 | -- ensure unfoldings are available 83 | -fno-omit-interface-pragmas 84 | -fplugin Categorifier 85 | -fplugin-opt Categorifier:defer-failures 86 | 87 | -- run without any explicit integration (uses only bits from base 88 | test-suite default-plugin 89 | import: tests 90 | type: exitcode-stdio-1.0 91 | main-is: Base/Main.hs 92 | ghc-options: 93 | -O0 94 | 95 | common hierarchy-tests 96 | import: tests 97 | ghc-options: 98 | -fplugin-opt Categorifier:hierarchy:Categorifier.Hierarchy.baseHierarchy 99 | 100 | test-suite base-hierarchy 101 | import: hierarchy-tests 102 | type: exitcode-stdio-1.0 103 | main-is: Base/Main.hs 104 | ghc-options: 105 | -O0 106 | 107 | test-suite base-hierarchy-optimized 108 | import: hierarchy-tests 109 | type: exitcode-stdio-1.0 110 | main-is: Base/Main.hs 111 | ghc-options: 112 | -O2 113 | -fignore-interface-pragmas 114 | -------------------------------------------------------------------------------- /plugin/Categorifier.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | 4 | -- | Create a GHC plugin that implements Conal Elliott's [Compiling to 5 | -- Categories](http://conal.net/papers/compiling-to-categories/compiling-to-categories.pdf). 6 | -- 7 | -- It replaces calls to `Categorifier.Categorify.expression` with the expression in the target 8 | -- category. 9 | module Categorifier 10 | ( plugin, 11 | ) 12 | where 13 | 14 | import Categorifier.CommandLineOptions (OptionGroup, partitionOptions) 15 | import Categorifier.Common.IO.Exception (throwIOAsException) 16 | import qualified Categorifier.Core 17 | import qualified Categorifier.GHC.Core as GhcPlugins 18 | import qualified Categorifier.GHC.Driver as GhcPlugins 19 | import Control.Applicative (liftA2) 20 | import Control.Monad (join) 21 | import Data.Either.Validation (Validation (..)) 22 | import Data.Foldable (toList) 23 | import Data.Map (Map) 24 | import Data.Text (Text) 25 | import qualified Data.Text as Text 26 | import PyF (fmt) 27 | 28 | -- | The required plugin entry-point. See [the GHC User's Guide section on Compiler 29 | -- Plugins](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/extending_ghc.html#compiler-plugins) [ ](DONTLINTLINELENGTH) 30 | -- for more information. 31 | plugin :: GhcPlugins.Plugin 32 | plugin = 33 | GhcPlugins.defaultPlugin 34 | { GhcPlugins.installCoreToDos = 35 | \opts -> 36 | join 37 | . GhcPlugins.liftIO 38 | . liftA2 Categorifier.Core.install (partitionOptions' opts) 39 | . pure, 40 | GhcPlugins.pluginRecompile = GhcPlugins.flagRecompile 41 | } 42 | 43 | partitionOptions' :: [GhcPlugins.CommandLineOption] -> IO (Map OptionGroup [Text]) 44 | partitionOptions' opts = 45 | case partitionOptions opts of 46 | Success groups -> pure groups 47 | Failure errs -> 48 | throwIOAsException 49 | ( \badOpts -> 50 | [fmt| The following option groups passed to the Categorifier GHC plugin were 51 | unrecognized: 52 | - {Text.intercalate "\n- " $ toList badOpts}|] 53 | ) 54 | errs 55 | -------------------------------------------------------------------------------- /plugin/Categorifier/Benchmark.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | {-# LANGUAGE TupleSections #-} 3 | 4 | module Categorifier.Benchmark 5 | ( Benchmark (..), 6 | billTo, 7 | billToUninterruptible, 8 | displayTimes, 9 | ) 10 | where 11 | 12 | import Categorifier.Common.IO.Exception (evaluate) 13 | import Control.Monad.IO.Class (MonadIO (..)) 14 | import Data.Foldable (for_) 15 | import Data.Functor (($>)) 16 | import Data.IORef.Extra (IORef, modifyIORef', readIORef, writeIORef') 17 | import Data.List (sortOn) 18 | import Data.Map.Strict (Map) 19 | import qualified Data.Map.Strict as Map 20 | import Debug.Trace (traceM) 21 | import PyF (fmt) 22 | import System.IO.Unsafe (unsafePerformIO) 23 | import System.Time.Extra (Seconds, offsetTime) 24 | 25 | -- TODO: The field comments should be Haddock once we no longer support GHC 8. 26 | data Benchmark a 27 | = Benchmark 28 | -- The (interruptible) account currently being billed 29 | (Maybe (a, Seconds)) 30 | -- Meters 31 | (Map a Seconds) 32 | 33 | getElapsed :: IO Seconds 34 | getElapsed = unsafePerformIO offsetTime 35 | {-# NOINLINE getElapsed #-} 36 | 37 | addTime :: forall a. (Ord a) => Seconds -> a -> Map a Seconds -> Map a Seconds 38 | addTime time = Map.alter (maybe (Just time) (Just . (+ time))) 39 | 40 | -- | Switch to the given account, and return the old account 41 | switchAccount :: forall a. (Ord a) => IORef (Benchmark a) -> Maybe a -> IO (Maybe a) 42 | switchAccount ref mbNewAccount = do 43 | currentTime <- getElapsed 44 | Benchmark mbOldAccount oldMeters <- readIORef ref 45 | let meters = case mbOldAccount of 46 | Just (account, startTime) -> addTime (currentTime - startTime) account oldMeters 47 | Nothing -> oldMeters 48 | writeIORef' ref $ Benchmark (fmap (,currentTime) mbNewAccount) meters 49 | pure $ fst <$> mbOldAccount 50 | 51 | -- | Bill to the given account. If the given action calls `billTo` or 52 | -- `billToUninterruptible` on a sub-action, billing to the current account 53 | -- will be suspended until the sub-action completes. 54 | billTo :: forall a r m. (MonadIO m, Ord a) => Bool -> IORef (Benchmark a) -> a -> m r -> m r 55 | billTo enableDebugging ref newAccount act 56 | | not enableDebugging = act 57 | | otherwise = do 58 | oldAccount <- liftIO $ switchAccount ref (Just newAccount) 59 | res <- act >>= liftIO . evaluate 60 | -- TODO: this should ideally be in `finally`, but `CategoryStack` is not `MonadUnliftIO`. 61 | liftIO (switchAccount ref oldAccount) $> res 62 | 63 | -- | Like `billTo`, but keep billing to the given account even if the given 64 | -- action calls `billTo` or `billToUninterruptible`. 65 | billToUninterruptible :: 66 | forall a r m. 67 | (MonadIO m, Ord a) => 68 | Bool -> 69 | IORef (Benchmark a) -> 70 | a -> 71 | m r -> 72 | m r 73 | billToUninterruptible enableDebugging ref newAccount act 74 | | not enableDebugging = act 75 | | otherwise = do 76 | oldAccount <- liftIO $ switchAccount ref Nothing 77 | startTime <- liftIO getElapsed 78 | res <- act >>= liftIO . evaluate 79 | -- TODO: this should ideally be in `finally`, but `CategoryStack` is not `MonadUnliftIO`. 80 | endTime <- liftIO getElapsed 81 | liftIO . modifyIORef' ref $ 82 | \(Benchmark account meters) -> 83 | Benchmark account $ addTime (endTime - startTime) newAccount meters 84 | liftIO (switchAccount ref oldAccount) $> res 85 | 86 | displayTimes :: forall a m. (MonadIO m, Show a) => IORef (Benchmark a) -> m () 87 | displayTimes ref = liftIO $ do 88 | traceM "============Benchmark============" 89 | Benchmark _ meters <- readIORef ref 90 | for_ (sortOn (negate . snd) $ Map.toList meters) $ \(account, time) -> 91 | traceM [fmt|{show account}: {time:.2}s|] 92 | traceM "========End of Benchmark=========" 93 | -------------------------------------------------------------------------------- /plugin/Categorifier/CommandLineOptions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- | Manages and parses /all/ the options for every part of the plugin. This is because the set of 4 | -- command-line options is shared across the entire plugin, so we can't have each component check 5 | -- for its own plugins while also erroring if we get unrecognized options. 6 | module Categorifier.CommandLineOptions 7 | ( OptionGroup (..), 8 | partitionOptions, 9 | ) 10 | where 11 | 12 | import qualified Categorifier.GHC.Driver as GhcPlugins 13 | import Data.Bifunctor (Bifunctor (..)) 14 | import Data.Either.Validation (Validation (..)) 15 | import Data.List (elemIndex) 16 | import Data.List.NonEmpty (NonEmpty) 17 | import Data.Map (Map) 18 | import qualified Data.Map as Map 19 | import Data.Text (Text) 20 | import qualified Data.Text as Text 21 | import Data.Tuple.Extra (firstM) 22 | 23 | -- | An enumeration of the various command-line option groups the plugin supports. 24 | data OptionGroup 25 | = AdditionalBoxersOptions 26 | | AutoInterpreterOptions 27 | | BenchmarkOption 28 | | DebugOption 29 | | DeferFailuresOption 30 | | HierarchyOptions 31 | | LookupOptions 32 | | MakerMapOptions 33 | deriving (Eq, Ord) 34 | 35 | groupFromText :: Text -> Maybe OptionGroup 36 | groupFromText = \case 37 | "additional-boxers" -> pure AdditionalBoxersOptions 38 | "autointerpreter" -> pure AutoInterpreterOptions 39 | "benchmark" -> pure BenchmarkOption 40 | "debug" -> pure DebugOption 41 | "defer-failures" -> pure DeferFailuresOption 42 | "hierarchy" -> pure HierarchyOptions 43 | "lookup" -> pure LookupOptions 44 | "maker-map" -> pure MakerMapOptions 45 | _ -> Nothing 46 | 47 | -- | We expect all options to be in the format `:`, and we (often) allow duplicate 48 | -- entries in the same group. This splits them so that we have a list of values for each group 49 | -- (with the order within the group maintained). 50 | -- 51 | -- This fails (returning the failing group names) if any of the option groups are unrecognized. 52 | -- 53 | -- __NB__: GHC hands us the options in reverse order 54 | -- (https://gitlab.haskell.org/ghc/ghc/-/issues/17884), so we fix the order here. At some 55 | -- point, GHC will hopefully fix this, which means we'll need to cunditionalize the 56 | -- reversal for a time. 57 | partitionOptions :: 58 | [GhcPlugins.CommandLineOption] -> Validation (NonEmpty Text) (Map OptionGroup [Text]) 59 | partitionOptions = 60 | fmap (Map.fromListWith (<>)) 61 | . traverse 62 | ( \opt -> 63 | firstM findKey . maybe (Text.pack opt, []) (bimap Text.pack (pure . Text.pack)) $ 64 | splitAroundElem separator opt 65 | ) 66 | . reverse 67 | where 68 | separator = ':' 69 | splitAroundElem :: (Eq a) => a -> [a] -> Maybe ([a], [a]) 70 | splitAroundElem e as = fmap (drop 1) . flip splitAt as <$> elemIndex e as 71 | findKey :: Text -> Validation (NonEmpty Text) OptionGroup 72 | findKey k = maybe (Failure $ pure k) pure $ groupFromText k 73 | -------------------------------------------------------------------------------- /plugin/Categorifier/Core/Base.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | 3 | -- | The `Categorifier.Core.Hierarchy.baseHierarchy` can support most of categorification (`arr` is a 4 | -- very powerful operation), but it doesn't provide all of the appropriate functions and some of 5 | -- them are too complicated to encode directly in GHC Core. This module bridges the gap to make 6 | -- the Core definitions more tractable. 7 | module Categorifier.Core.Base 8 | ( distlB, 9 | fixB, 10 | ifThenElseB, 11 | lassocB, 12 | rassocB, 13 | strengthB, 14 | uncurryB, 15 | ) 16 | where 17 | 18 | import Control.Arrow (Arrow (arr, first), ArrowLoop (..)) 19 | import Control.Category (Category (..)) 20 | import Data.Bifunctor (Bifunctor (bimap)) 21 | import Prelude hiding ((.)) 22 | 23 | distlB :: (Bifunctor f) => (a, f b c) -> f (a, b) (a, c) 24 | distlB (a, fbc) = bimap (a,) (a,) fbc 25 | 26 | fixB :: (ArrowLoop k) => k (a, x) x -> k a x 27 | fixB f = loop (arr (\x -> (x, x)) . f) 28 | 29 | ifThenElseB :: (Bool, (a, a)) -> a 30 | ifThenElseB (t, (c, a)) = if t then c else a 31 | 32 | lassocB :: (a, (b, c)) -> ((a, b), c) 33 | lassocB (a, (b, c)) = ((a, b), c) 34 | 35 | rassocB :: ((a, b), c) -> (a, (b, c)) 36 | rassocB ((a, b), c) = (a, (b, c)) 37 | 38 | strengthB :: (Functor f) => (a, f b) -> f (a, b) 39 | strengthB (a, fb) = (a,) <$> fb 40 | 41 | uncurryB :: (Arrow k) => k a (b -> c) -> k (a, b) c 42 | uncurryB f = arr (uncurry ($)) . first f 43 | -------------------------------------------------------------------------------- /plugin/Categorifier/Core/Benchmark.hs: -------------------------------------------------------------------------------- 1 | module Categorifier.Core.Benchmark 2 | ( Account (..), 3 | billTo, 4 | billToUninterruptible, 5 | displayTimes, 6 | ) 7 | where 8 | 9 | import qualified Categorifier.Benchmark as Benchmark 10 | import Control.Monad.IO.Class (MonadIO (..)) 11 | import Data.IORef.Extra (IORef, newIORef) 12 | import qualified Data.Map.Strict as Map 13 | import System.IO.Unsafe (unsafePerformIO) 14 | 15 | data Account 16 | = BuildDictionary 17 | | Categorify 18 | deriving (Eq, Ord, Show) 19 | 20 | ref :: IORef (Benchmark.Benchmark Account) 21 | ref = unsafePerformIO . newIORef $ Benchmark.Benchmark Nothing Map.empty 22 | {-# NOINLINE ref #-} 23 | 24 | billTo :: (MonadIO m) => Bool -> Account -> m r -> m r 25 | billTo enableDebugging = Benchmark.billTo enableDebugging ref 26 | 27 | billToUninterruptible :: (MonadIO m) => Bool -> Account -> m r -> m r 28 | billToUninterruptible enableDebugging = Benchmark.billToUninterruptible enableDebugging ref 29 | 30 | displayTimes :: (MonadIO m) => m () 31 | displayTimes = Benchmark.displayTimes ref 32 | -------------------------------------------------------------------------------- /plugin/Categorifier/Core/Functions.hs: -------------------------------------------------------------------------------- 1 | -- | Various functions that are used internally for the plugin conversion. 2 | -- 3 | -- The @INLINE@ pragmas on these are very delicate. We need to ensure that these functions aren't 4 | -- accidentally inlined before or during categorification. The need to be either /explicitly/ 5 | -- inlined by the plugin or preserved until we can map them to morphisms in the target 6 | -- category. We use @INLINE [0]@ instead of @NOINLINE@ so that the unfoldings are still created 7 | -- for our manual inlining, but they should never persist long enough to be inlined by the 8 | -- simplifier. 9 | module Categorifier.Core.Functions 10 | ( abst, 11 | repr, 12 | ) 13 | where 14 | 15 | import qualified Categorifier.Client as Client 16 | 17 | -- | Lower `abst` from a method to a function, for inlining purposes. 18 | abst :: (Client.HasRep a) => Client.Rep a -> a 19 | abst = Client.abst 20 | {-# INLINE [0] abst #-} 21 | 22 | -- | Lower `repr` from a method to a function, for inlining purposes. 23 | repr :: (Client.HasRep a) => a -> Client.Rep a 24 | repr = Client.repr 25 | {-# INLINE [0] repr #-} 26 | -------------------------------------------------------------------------------- /plugin/Categorifier/Core/Trace.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | 4 | -- | Conditional tracing of plugin components. 5 | module Categorifier.Core.Trace 6 | ( renderSDoc, 7 | pprTrace', 8 | traceWith, 9 | maybeTraceWith, 10 | maybeTraceWithStack, 11 | takeLines, 12 | addIdInfo, 13 | ) 14 | where 15 | 16 | import qualified Categorifier.GHC.Core as Plugins 17 | import qualified Categorifier.GHC.Driver as Plugins 18 | import qualified Categorifier.GHC.Types as Plugins 19 | import qualified Categorifier.GHC.Unit as Plugins 20 | import qualified Categorifier.GHC.Utils as Plugins 21 | import Control.Monad.IO.Class (MonadIO (liftIO)) 22 | import Data.Bifunctor (Bifunctor (..)) 23 | import Data.Bool (bool) 24 | import Data.IORef (IORef, modifyIORef', newIORef, readIORef) 25 | import qualified Data.List.Extra as List 26 | import Data.Maybe (fromMaybe, listToMaybe) 27 | import qualified Data.Set as Set 28 | import Debug.Trace (trace, traceM) 29 | import PyF (fmt) 30 | import System.IO.Unsafe (unsafePerformIO) 31 | import System.Time.Extra (Seconds, offsetTime) 32 | 33 | -- | Like 'Plugins.showSDoc', but qualifies some ambiguous names, and also shortens 34 | -- large output. 35 | renderSDoc :: Plugins.DynFlags -> Plugins.SDoc -> String 36 | renderSDoc dflags sdoc = takeLines 20 20 $ Plugins.renderWithStyle dflags qual sdoc 37 | where 38 | qual = 39 | Plugins.neverQualify 40 | { Plugins.queryQualifyName = \modu name -> 41 | if Plugins.occNameString name `Set.member` ambiguousNames 42 | then Plugins.NameQual (Plugins.moduleName modu) 43 | else Plugins.NameUnqual 44 | } 45 | ambiguousNames = Set.fromList ["Dict", "Rep"] 46 | 47 | -- | Hacky eliminable tracing. Just switch the commented-out implementation to enable or disable 48 | -- tracing. 49 | pprTrace' :: String -> Plugins.SDoc -> a -> a 50 | -- pprTrace' = Plugins.pprTrace 51 | pprTrace' _ _ = id 52 | 53 | -- | The important missing function from "Debug.Trace". It generalizes `Debug.Trace.traceShowId` to 54 | -- take an arbitrary function rather than relying on `show`. E.g., 55 | -- >>> trace msg = traceWith (const msg) 56 | -- >>> traceId = traceWith id 57 | -- >>> traceShow x = traceWith (const (show x)) 58 | -- >>> traceShowId = traceWith show 59 | traceWith :: (a -> String) -> a -> a 60 | traceWith f a = trace (f a) a 61 | 62 | maybeTraceWith :: Bool -> (a -> String) -> a -> a 63 | maybeTraceWith = bool (const id) (traceWith . withTime) 64 | where 65 | withTime f a = unsafePerformIO $ do 66 | elapsed <- getElapsed 67 | pure [fmt|[{elapsed:.2}s] - {f a}|] 68 | {-# INLINE maybeTraceWith #-} 69 | {-# ANN maybeTraceWith ("HLint: ignore Missing NOINLINE pragma" :: String) #-} 70 | 71 | maybeTraceWithStack :: (MonadIO m) => Bool -> (a -> String) -> (a -> m b) -> a -> m b 72 | maybeTraceWithStack doTrace render act a = 73 | if doTrace 74 | then do 75 | (stepId, stack) <- liftIO $ readIORef stepInfoRef 76 | liftIO $ modifyIORef' stepInfoRef (bimap (+ 1) (stepId :)) 77 | let parentId = fromMaybe (-1) (listToMaybe stack) 78 | elapsed <- liftIO getElapsed 79 | traceM [fmt|[{elapsed:.2}s] - step {show (stepId, parentId)}: {render a}|] 80 | res <- act a 81 | elapsed' <- liftIO getElapsed 82 | traceM [fmt|[{elapsed':.2}s] - completed step {stepId}, returning to step {parentId}|] 83 | liftIO . modifyIORef' stepInfoRef . second $ drop 1 84 | pure res 85 | else act a 86 | {-# INLINE maybeTraceWithStack #-} 87 | 88 | -- | Take @x@ lines at the beginning, and @y@ lines at the end of a string, 89 | -- and replace everything in the middle (if any) with @"(...omitted k lines)"@. 90 | -- 91 | -- No-op if either @x@ or @y@ is negative. 92 | takeLines :: Int -> Int -> String -> String 93 | takeLines x y s 94 | | x < 0 || y < 0 = s 95 | | otherwise = [fmt|{prefix}{omitted}{suffix}|] 96 | where 97 | (xs, (zs, ws)) = List.splitAtEnd y <$> List.splitAt x (List.lines s) 98 | prefix = List.intercalate "\n" xs 99 | omitted = if null zs then "" else [fmt|\n<...omitted {length zs} lines>|] :: String 100 | suffix = 101 | if null ws || y == 0 102 | then "" 103 | else (if x == 0 && null zs then "" else "\n") <> List.intercalate "\n" ws 104 | 105 | -- | An `IORef` holding (incrementing step id, call stack). 106 | stepInfoRef :: IORef (Int, [Int]) 107 | stepInfoRef = unsafePerformIO (newIORef (0, [])) 108 | {-# NOINLINE stepInfoRef #-} 109 | 110 | getElapsed :: IO Seconds 111 | getElapsed = unsafePerformIO offsetTime 112 | {-# NOINLINE getElapsed #-} 113 | 114 | addIdInfo :: Plugins.CoreExpr -> Plugins.Expr Plugins.WithIdInfo 115 | addIdInfo = \case 116 | Plugins.Var v -> Plugins.Var v 117 | Plugins.Lit l -> Plugins.Lit l 118 | Plugins.App e a -> Plugins.App (addIdInfo e) (addIdInfo a) 119 | Plugins.Lam b e -> Plugins.Lam (Plugins.WithIdInfo b) (addIdInfo e) 120 | Plugins.Let b e -> Plugins.Let (addIdInfoBind b) (addIdInfo e) 121 | Plugins.Case scrut bind ty alts -> 122 | Plugins.Case (addIdInfo scrut) (Plugins.WithIdInfo bind) ty $ fmap addIdInfoAlt alts 123 | Plugins.Cast e c -> Plugins.Cast (addIdInfo e) c 124 | Plugins.Tick tickish e -> Plugins.Tick tickish $ addIdInfo e 125 | Plugins.Type ty -> Plugins.Type ty 126 | Plugins.Coercion c -> Plugins.Coercion c 127 | where 128 | addIdInfoAlt (Plugins.Alt con binds expr) = 129 | Plugins.Alt con (fmap Plugins.WithIdInfo binds) (addIdInfo expr) 130 | addIdInfoBind = \case 131 | Plugins.NonRec b e -> Plugins.NonRec (Plugins.WithIdInfo b) $ addIdInfo e 132 | Plugins.Rec alts -> Plugins.Rec $ fmap (bimap Plugins.WithIdInfo addIdInfo) alts 133 | -------------------------------------------------------------------------------- /plugin/Categorifier/Core/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE TupleSections #-} 3 | 4 | module Categorifier.Core.Types 5 | ( AutoInterpreter, 6 | CategoryStack, 7 | DictionaryStack, 8 | CategoryState (..), 9 | DictCache, 10 | DictCacheKey, 11 | DictCacheEntry (..), 12 | CategoricalFailure (..), 13 | Lookup, 14 | MissingSymbol (..), 15 | DictionaryFailure (..), 16 | liftDictionaryStack, 17 | neverAutoInterpret, 18 | writerT, 19 | ) 20 | where 21 | 22 | import Categorifier.Duoidal (Parallel) 23 | import qualified Categorifier.GHC.Core as Plugins 24 | import qualified Categorifier.GHC.Types as Plugins 25 | import qualified Categorifier.GHC.Utils as Plugins 26 | import Control.Monad.Trans.Except (ExceptT (..), mapExceptT) 27 | import Control.Monad.Trans.RWS.Strict (RWST (..), withRWST) 28 | import Data.Bifunctor (Bifunctor (..)) 29 | import Data.List.NonEmpty (NonEmpty) 30 | import Data.Map (Map) 31 | import qualified Language.Haskell.TH as TH 32 | 33 | type CategoryStack = 34 | ExceptT 35 | (NonEmpty CategoricalFailure) 36 | (RWST (Map Plugins.Var Plugins.CoreExpr) Plugins.WarningMessages CategoryState IO) 37 | 38 | type DictionaryStack = 39 | ExceptT 40 | (NonEmpty DictionaryFailure) 41 | (RWST () Plugins.WarningMessages CategoryState IO) 42 | 43 | liftDictionaryStack :: Plugins.Type -> Plugins.CoreExpr -> DictionaryStack a -> CategoryStack a 44 | liftDictionaryStack ty expr = 45 | mapExceptT (fmap (first (pure . CouldNotBuildDictionary ty expr)) . withRWST (const ((),))) 46 | 47 | data CategoryState = CategoryState 48 | { csUniqSupply :: Plugins.UniqSupply, 49 | -- An incrementing index, used to populate `dceIdx`. 50 | csIdx :: Int, 51 | csDictCache :: DictCache 52 | } 53 | 54 | data MissingSymbol 55 | = IncorrectType Plugins.Name Plugins.Type 56 | | NotAGlobalName TH.Name 57 | | MissingDataCon TH.Name 58 | | MissingId TH.Name 59 | | MissingName TH.Name 60 | | MissingTyCon TH.Name 61 | 62 | -- | This type lets us perform everything in `Plugins.CoreM` while tracking failures properly. It 63 | -- uses `Parallel` explicitly rather than relying on the `Categorifier.Duoid` operations because 64 | -- we want to take advantage of @do@ notation for building up our records. 65 | type Lookup = Parallel (ExceptT (NonEmpty MissingSymbol) Plugins.CoreM) 66 | 67 | -- | A mechanism to bypass the plugin, providing a mapping @(a -> b) -> cat a b@ for any special 68 | -- cases. 69 | type AutoInterpreter = 70 | (Plugins.Type -> DictionaryStack Plugins.CoreExpr) -> 71 | Plugins.Type -> 72 | Plugins.Type -> 73 | Plugins.Id -> 74 | [Plugins.CoreExpr] -> 75 | CategoryStack (Maybe Plugins.CoreExpr) 76 | 77 | -- | What to use for the `AutoInterpreter` if you have no need to bypass the plugin. 78 | neverAutoInterpret :: Lookup AutoInterpreter 79 | neverAutoInterpret = pure $ \_ _ _ _ _ -> pure Nothing 80 | 81 | type DictCache = Map DictCacheKey DictCacheEntry 82 | 83 | type DictCacheKey = String 84 | 85 | data DictCacheEntry = DictCacheEntry 86 | { -- | goalTy 87 | dceType :: Plugins.Type, 88 | dceVar :: Plugins.Var, 89 | -- | The actual dictionary 90 | dceDict :: Plugins.CoreExpr, 91 | -- | Index of the created dict var, used for topological sort. Contains a value 92 | -- if `dceVar` is created during `Categorifier.Core.BuildDictionary.buildDictionary`. 93 | -- A var with a smaller index is created earler, and thus may be referred to in 94 | -- the unfolding of a var with a bigger index. 95 | dceIdx :: Maybe Int 96 | } 97 | 98 | -- | Various ways in which the plugin can fail to transform a term. 99 | data CategoricalFailure 100 | = BareUnboxedVar Plugins.Var (Plugins.Expr Plugins.WithIdInfo) 101 | | CouldNotBuildDictionary Plugins.Type Plugins.CoreExpr (NonEmpty DictionaryFailure) 102 | | FailureToUnfix Plugins.Id Plugins.CoreExpr Plugins.CoreExpr 103 | | InvalidUnfixTyArgs Plugins.Id [Plugins.Var] [Plugins.Type] 104 | | -- | The class hierarchy that was used has no mapping for some required operation. 105 | MissingCategoricalRepresentation String 106 | | NotEnoughTypeArgs String Plugins.CoreExpr Plugins.Type [Plugins.Type] 107 | | NotFunTy Plugins.CoreExpr Plugins.Type 108 | | NotTyConApp String Plugins.Type 109 | | TypeMismatch String Plugins.Type Plugins.Type 110 | | UninlinedExpr Plugins.CoreExpr (Maybe Plugins.Unfolding) 111 | | UnsupportedCast Plugins.CoreExpr Plugins.Coercion 112 | | UnsupportedDependentType Plugins.Var (Either Plugins.Coercion Plugins.Type) 113 | | UnsupportedMutuallyRecursiveLetBindings [(Plugins.CoreBndr, Plugins.CoreExpr)] 114 | | UnsupportedPolymorphicRecursion Plugins.Id [Plugins.Var] [Plugins.Type] 115 | | UnexpectedUnboxedType String Plugins.Type Plugins.CoreExpr 116 | | CannotDeduceBoxedTypeOfBinder Plugins.Var Plugins.CoreExpr Plugins.CoreExpr 117 | | UnsupportedPrimitiveDataAlt Plugins.DataCon Plugins.CoreExpr 118 | | UnexpectedMissingDefault Plugins.CoreExpr 119 | | UnexpectedDoubleDefault Plugins.CoreExpr 120 | | UnsupportedPrimitiveLiteral Plugins.Literal Plugins.CoreExpr 121 | | CannotDeduceBoxedTypeOfExpr Plugins.CoreExpr Plugins.CoreExpr 122 | | UnsupportedPrimOpApplication Plugins.Var [Plugins.CoreExpr] (Maybe Plugins.Type) 123 | | UnsupportedPrimOpExpression String Plugins.CoreExpr 124 | 125 | data DictionaryFailure 126 | = TypecheckFailure Plugins.ErrorMessages 127 | | -- | Typechecking ostensibly succeeded, but also returned errors. Not sure if this is possible, 128 | -- but the types allow for it. Here we treat it as a failure in order to at least diagnose the 129 | -- problem. 130 | forall r. (Plugins.Outputable r) => ErroneousTypecheckSuccess Plugins.ErrorMessages r 131 | | NoBindings 132 | | CoercionHoles (NonEmpty (Plugins.Bind Plugins.CoreBndr)) 133 | | FreeIds (NonEmpty (Plugins.Id, Plugins.Kind)) 134 | 135 | -- | Construct a writer computation from a (result, output) pair inside the monad. 136 | writerT :: (Functor m) => m (a, w) -> RWST r w s m a 137 | writerT x = RWST (\_ s -> uncurry (,s,) <$> x) 138 | -------------------------------------------------------------------------------- /plugin/Categorifier/Test/CategorizeException.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskellQuotes #-} 2 | 3 | module Test.CategorifyException 4 | ( hprop_correctException, 5 | ) 6 | where 7 | 8 | import qualified Categorifier.Categorify as Categorify 9 | import Categorifier.Common.IO.Exception (evaluate, try) 10 | import GHC.Stack (SrcLoc (..), getCallStack) 11 | import qualified Hedgehog 12 | import qualified Language.Haskell.TH as TH 13 | import P 14 | 15 | hprop_correctException :: Hedgehog.Property 16 | hprop_correctException = 17 | Hedgehog.property 18 | . either 19 | -- __NB__: Ensures we get a `CallStack` that is useful to a user. 20 | ( \(Categorify.UnconvertedCall _ calls) -> 21 | -- __NB__: The `srcLocPackage` varies depending on the build target, so we effectively 22 | -- ignore it. 23 | fmap (fmap (\frame -> frame {srcLocPackage = ""})) (getCallStack calls) 24 | Hedgehog.=== [ ( TH.nameBase 'Categorify.expression, 25 | SrcLoc 26 | { srcLocPackage = "", 27 | srcLocModule = 28 | fromMaybe "" $ TH.nameModule 'hprop_correctException, 29 | srcLocFile = 30 | "code_generation/plugin/Test/Plugin/CategorifyException.hs", 31 | srcLocStartLine = 41, 32 | srcLocStartCol = 9, 33 | srcLocEndLine = 41, 34 | srcLocEndCol = 33 35 | } 36 | ) 37 | ] 38 | ) 39 | (const Hedgehog.failure) 40 | <=< Hedgehog.evalIO 41 | . try 42 | . evaluate 43 | $ Categorify.expression id 44 | -------------------------------------------------------------------------------- /plugin/Categorifier/Test/Chaos.hs: -------------------------------------------------------------------------------- 1 | -- | This module defines a plugin that is designed to not play well with other plugins. It helps 2 | -- ensure that we're programming our plugins defensively and at least being informative when we 3 | -- can't recover. 4 | module Test.Chaos 5 | ( plugin, 6 | ) 7 | where 8 | 9 | import qualified Categorifier.GHC.Driver as Plugins 10 | import P 11 | 12 | -- | This plugin simply deletes all the `Plugins.CoreToDo`s that exist. It should surface any bugs 13 | -- that are caused by your plugin relying on effects from other passes that exist incidentally. 14 | plugin :: Plugins.Plugin 15 | plugin = Plugins.defaultPlugin {Plugins.installCoreToDos = \_opts _todos -> pure []} 16 | -------------------------------------------------------------------------------- /plugin/Categorifier/Test/PartialApplication.hs: -------------------------------------------------------------------------------- 1 | module Test.PartialApplication 2 | ( hprop_partialApplication, 3 | hprop_functionApplication, 4 | hprop_functionPartialApplication, 5 | ) 6 | where 7 | 8 | import qualified Categorifier.Categorify as Categorify 9 | import qualified Hedgehog 10 | import qualified Hedgehog.Gen as Gen 11 | import P 12 | import Test.Hask (Hask (..)) 13 | 14 | testArrow :: Hask (Char, (Char, Char)) Char -> Hedgehog.Property 15 | testArrow arrow = Hedgehog.property $ do 16 | input <- 17 | Hedgehog.forAll 18 | ( (,) 19 | <$> genIntegralBounded 20 | <*> ( (,) 21 | <$> Gen.enumBounded 22 | <*> Gen.enumBounded 23 | ) :: 24 | Hedgehog.Gen (Char, (Char, Char)) 25 | ) 26 | runHask arrow input Hedgehog.=== fst (snd input) 27 | 28 | hprop_partialApplication :: Hedgehog.Property 29 | hprop_partialApplication = testArrow (Categorify.expression $ fst . snd) 30 | 31 | -- | This, unsurprisingly, has to be inlined for it to work, which perhaps makes it seem like not 32 | -- a good test. But it should at least indicate to us whether inlining is being applied at the 33 | -- correct time before our plugin is triggered. 34 | preApply :: (a -> b) -> a `c` b 35 | preApply = Categorify.expression 36 | {-# INLINE preApply #-} 37 | 38 | hprop_functionApplication :: Hedgehog.Property 39 | hprop_functionApplication = testArrow (preApply (fst . snd)) 40 | 41 | hprop_functionPartialApplication :: Hedgehog.Property 42 | hprop_functionPartialApplication = testArrow (preApply $ fst . snd) 43 | -------------------------------------------------------------------------------- /plugin/Categorifier/Test/WithInstance.hs: -------------------------------------------------------------------------------- 1 | module Test.WithInstance 2 | ( test, 3 | ) 4 | where 5 | 6 | import qualified Categorifier.Categorify as Categorify 7 | import ConCat.Category (Category (..)) 8 | import P hiding (id, (.)) 9 | 10 | -- | The terminal object in __Cat__ -- a category with only a single object (up to unique 11 | -- isomorphism), whose only arrow is its identity. 12 | data Term a b = ZeroId 13 | deriving (Show) 14 | 15 | instance Category Term where 16 | id = ZeroId 17 | 18 | ZeroId . ZeroId = ZeroId 19 | 20 | test :: Term Int Int 21 | test = Categorify.expression id 22 | -------------------------------------------------------------------------------- /plugin/Categorifier/Test/WithInstance/Main.hs: -------------------------------------------------------------------------------- 1 | module Main 2 | ( main, 3 | ) 4 | where 5 | 6 | import P () 7 | import System.IO (IO, print) 8 | import Test.WithInstance (test) 9 | 10 | main :: IO () 11 | main = print test 12 | -------------------------------------------------------------------------------- /plugin/categorifier-plugin.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-plugin 4 | version: 0.1 5 | description: GHC plugin for Compiling to Categories 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | extra-doc-files: README.md 9 | build-type: Simple 10 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 11 | 12 | source-repository head 13 | type: git 14 | location: https://github.com/con-kitty/categorifier 15 | 16 | common defaults 17 | ghc-options: 18 | -Wall 19 | build-depends: 20 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 21 | default-language: Haskell2010 22 | default-extensions: 23 | BangPatterns 24 | DeriveDataTypeable 25 | DeriveFoldable 26 | DeriveFunctor 27 | DeriveGeneric 28 | DeriveTraversable 29 | DerivingStrategies 30 | FlexibleContexts 31 | FlexibleInstances 32 | FunctionalDependencies 33 | InstanceSigs 34 | LambdaCase 35 | ScopedTypeVariables 36 | StandaloneDeriving 37 | TypeApplications 38 | TypeOperators 39 | 40 | library 41 | import: defaults 42 | exposed-modules: 43 | Categorifier 44 | -- __NB__: Only public for runtime lookup 45 | Categorifier.Core.Base 46 | Categorifier.Categorify 47 | -- __TODO__: move ...Categorify to other-modules 48 | Categorifier.Core.Categorify 49 | -- __TODO__: move ...Functions to other-modules 50 | Categorifier.Core.Functions 51 | Categorifier.Core.MakerMap 52 | Categorifier.Core.Makers 53 | -- __TODO__: move ...PrimOp to other-modules 54 | Categorifier.Core.PrimOp 55 | Categorifier.Core.Types 56 | Categorifier.Hierarchy 57 | other-modules: 58 | Categorifier.Benchmark 59 | Categorifier.CommandLineOptions 60 | Categorifier.Core 61 | Categorifier.Core.Benchmark 62 | Categorifier.Core.BuildDictionary 63 | Categorifier.Core.ErrorHandling 64 | Categorifier.Core.Trace 65 | Paths_categorifier_plugin 66 | autogen-modules: 67 | Paths_categorifier_plugin 68 | ghc-options: 69 | -O2 70 | -fignore-interface-pragmas 71 | build-depends: 72 | , PyF ^>=0.9.0 || ^>=0.10.0 || ^>=0.11.0 73 | , barbies ^>=2.0.1 74 | , bytestring ^>=0.10.9 || ^>=0.11.0 75 | , categorifier-category 76 | , categorifier-client 77 | , categorifier-common 78 | , categorifier-duoids 79 | , categorifier-ghc 80 | , categorifier-th 81 | , containers ^>=0.6.2 82 | , either ^>=5.0.1 83 | , extra ^>=1.7.8 84 | , ghc ^>=8.8.1 || ^>=8.10.1 || ^>=9.0.1 || ^>=9.2.1 85 | , ghc-prim ^>=0.5.3 || ^>=0.6.0 || ^>=0.7.0 || ^>=0.8.0 86 | , semialign ^>=1.1 || ^>=1.2 || ^>=1.3 87 | , semigroupoids ^>=5.3.4 88 | , syb ^>=0.7.1 89 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 90 | , text ^>=1.2.4 91 | , these ^>=1.1.1 || ^>=1.2 92 | , transformers ^>=0.5.6 || ^>=0.6.0 93 | , uniplate ^>=1.6.13 94 | , yaya ^>=0.3.2 || ^>=0.4.0 95 | -------------------------------------------------------------------------------- /th/categorifier-th.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | name: categorifier-th 4 | version: 0.1 5 | description: template-haskell extensions for Categorifier 6 | homepage: https://github.com/con-kitty/categorifier#readme 7 | bug-reports: https://github.com/con-kitty/categorifier/issues 8 | build-type: Simple 9 | tested-with: GHC==8.10.1, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.2.2, GHC==9.2.8 10 | 11 | source-repository head 12 | type: git 13 | location: https://github.com/con-kitty/categorifier 14 | 15 | common defaults 16 | ghc-options: 17 | -Wall 18 | build-depends: 19 | , base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 20 | default-language: Haskell2010 21 | default-extensions: 22 | BangPatterns 23 | DeriveDataTypeable 24 | DeriveFoldable 25 | DeriveFunctor 26 | DeriveGeneric 27 | DeriveTraversable 28 | DerivingStrategies 29 | FlexibleContexts 30 | FlexibleInstances 31 | FunctionalDependencies 32 | InstanceSigs 33 | LambdaCase 34 | ScopedTypeVariables 35 | StandaloneDeriving 36 | TypeApplications 37 | TypeOperators 38 | 39 | library 40 | import: defaults 41 | exposed-modules: 42 | Categorifier.TH 43 | Paths_categorifier_th 44 | autogen-modules: 45 | Paths_categorifier_th 46 | ghc-options: 47 | -O2 48 | -fignore-interface-pragmas 49 | build-depends: 50 | , PyF ^>=0.9.0 || ^>=0.10.0 || ^>=0.11.0 51 | , categorifier-common 52 | , categorifier-duoids 53 | , containers ^>=0.6.2 54 | , semialign ^>=1.1 || ^>=1.2 || ^>=1.3 55 | , template-haskell ^>=2.15.0 || ^>=2.16.0 || ^>=2.17.0 || ^>=2.18.0 56 | , these ^>=1.1.1 || ^>=1.2 57 | , transformers ^>=0.5.6 || ^>=0.6.0 58 | --------------------------------------------------------------------------------