From ca2435a0055917345a45a019ebcffb7485380137 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Sat, 22 May 2021 22:13:48 +1200 Subject: [PATCH 01/32] niv update nixpkgs-unstable --- nix/sources.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index 6066bdc1c2..85b30ddbb0 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -149,10 +149,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "410bbd828cdc6156aecd5bc91772ad3a6b1099c7", - "sha256": "0idvgvpgnzvk03yvd77lrca9qib936fq2x690jvk5gk3blsckz3r", + "rev": "5dbd28d75410738ee7a948c7dec9f9cb5a41fa9d", + "sha256": "1amwmy0hihhd9ylr0zbpwr8bmqbh8g003yydzqqckk0ql50dm97x", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/410bbd828cdc6156aecd5bc91772ad3a6b1099c7.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/5dbd28d75410738ee7a948c7dec9f9cb5a41fa9d.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "old-ghc-nix": { From 67a8eb91c0ffc01cb81c52b15157a6c448b59ffa Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Sat, 22 May 2021 22:14:54 +1200 Subject: [PATCH 02/32] ifdLevel 1 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index f00eba2ae3..ca3de7a550 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 3 +, ifdLevel ? 1 , checkMaterialization ? false }: let From 76ef6b645a28ad2a015495d9e2a46ea56bbb357c Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Sun, 23 May 2021 10:53:55 +1200 Subject: [PATCH 03/32] ifdLevel 2 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index ca3de7a550..02cb1f61d3 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 1 +, ifdLevel ? 2 , checkMaterialization ? false }: let From ef08fe3bbf3878c27bd73be9877ddf8fd9daa7fc Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Sun, 23 May 2021 14:05:14 +1200 Subject: [PATCH 04/32] ifdLevel 1 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index 02cb1f61d3..ca3de7a550 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 2 +, ifdLevel ? 1 , checkMaterialization ? false }: let From 3fc4bcccef6dce9b3d4a0ef92fbd2fd9b9d91890 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Sun, 23 May 2021 23:25:35 +1200 Subject: [PATCH 05/32] Fix ghcjs bash issue --- overlays/bootstrap.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index 6b190cf668..a623aafb28 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -696,10 +696,10 @@ in { final.buildPackages.buildPackages.gitMinimal final.buildPackages.buildPackages.nix-prefetch-git ]; in - final.symlinkJoin { + final.evalPackages.symlinkJoin { name = "nix-tools"; paths = exes; - buildInputs = [ final.makeWrapper ]; + buildInputs = [ final.evalPackages.makeWrapper ]; meta.platforms = final.lib.platforms.all; # We wrap the -to-nix executables with the executables from `tools` (e.g. nix-prefetch-git) # so that consumers of `nix-tools` won't have to provide those tools. From 51728121ebca357da239d71e9ae5ad5d93d0715f Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Sun, 23 May 2021 23:31:24 +1200 Subject: [PATCH 06/32] ifdLevel2 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index ca3de7a550..02cb1f61d3 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 1 +, ifdLevel ? 2 , checkMaterialization ? false }: let From 40f1dcd7a6f50db2c9bedc26ebaab23c25163745 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 24 May 2021 02:06:35 +1200 Subject: [PATCH 07/32] ifdLevel 3 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index 02cb1f61d3..f00eba2ae3 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 2 +, ifdLevel ? 3 , checkMaterialization ? false }: let From a464676c0a604dc30b914cdb78ca8c50a904c21e Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 24 May 2021 01:49:18 +1200 Subject: [PATCH 08/32] Fix ghcjs bash issue --- builder/default.nix | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/builder/default.nix b/builder/default.nix index 9d3e998d0c..4d1b10eda4 100644 --- a/builder/default.nix +++ b/builder/default.nix @@ -26,7 +26,8 @@ let # component builder and for nix-shells. ghcForComponent = import ./ghc-for-component-wrapper.nix { inherit lib ghc haskellLib; - inherit (buildPackages) stdenv runCommand makeWrapper; + inherit (buildPackages) stdenv; + inherit (pkgs.evalPackages) runCommand makeWrapper; inherit (buildPackages.xorg) lndir; }; From e51757d9b9a10d1af9ddc22bbde279aad154ee8d Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 24 May 2021 11:17:15 +1200 Subject: [PATCH 09/32] ifdLevel 2 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index f00eba2ae3..02cb1f61d3 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 3 +, ifdLevel ? 2 , checkMaterialization ? false }: let From 8ebba11d893cbc086dfdd2fee89aecc339f5deb2 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 24 May 2021 12:10:26 +1200 Subject: [PATCH 10/32] Fix ghcjs bash issue --- builder/default.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/builder/default.nix b/builder/default.nix index 4d1b10eda4..51d4b51dec 100644 --- a/builder/default.nix +++ b/builder/default.nix @@ -28,7 +28,7 @@ let inherit lib ghc haskellLib; inherit (buildPackages) stdenv; inherit (pkgs.evalPackages) runCommand makeWrapper; - inherit (buildPackages.xorg) lndir; + inherit (pkgs.evalPackages.xorg) lndir; }; # Builds a derivation which contains a ghc package-db of From 11b7385632022cc63884efdbc4096b0da870d307 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 24 May 2021 12:47:44 +1200 Subject: [PATCH 11/32] ifdLevel 3 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index 02cb1f61d3..f00eba2ae3 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 2 +, ifdLevel ? 3 , checkMaterialization ? false }: let From b2faf192c67962519d4c5375798ead7ee7eefc7e Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 17:22:19 +1200 Subject: [PATCH 12/32] Bump internal-* to ghc 8.10.4 (from 8.8.4) Anyone using `hpack` and/or `stack` will have a dependency on `internal-nix-tools` (built with a fixed version of ghc). This is fine if your `nixpkgs` is one of the ones we cache, but if not we may have to wait for an extra ghc to build. When this happens it would be nice if it is at least building a more recent version (rather than an older one). --- overlays/bootstrap.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index 6b190cf668..b276967df7 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -756,8 +756,8 @@ in { # there should be no difference in the behaviour of these tools. # (stack projects on macOS may see a significant change in the # closure size of their build dependencies due to dynamic linking). - internal-cabal-install = final.haskell-nix.cabal-install.ghc884; - internal-nix-tools = final.haskell-nix.nix-tools.ghc884; + internal-cabal-install = final.haskell-nix.cabal-install.ghc8104; + internal-nix-tools = final.haskell-nix.nix-tools.ghc8104; # WARN: The `import ../. {}` will prevent # any cross to work, as we will loose From 1c2c138815d6100935b28a52af9047a61e3cb543 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 22:26:48 +1200 Subject: [PATCH 13/32] Also update ci.nix --- ci.nix | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ci.nix b/ci.nix index d2709ac765..cfe4ec375b 100644 --- a/ci.nix +++ b/ci.nix @@ -25,7 +25,7 @@ # Update supported-ghc-versions.md to reflect any changes made here. { ghc865 = true; - ghc884 = false; # Just included because the native version is needed at eval time + ghc8104 = false; # Just included because the native version is needed at eval time } // nixpkgs.lib.optionalAttrs (nixpkgsName == "R2009") { ghc884 = true; ghc8104 = true; @@ -52,10 +52,10 @@ # Windows cross compilation is currently broken on macOS inherit (lib.systems.examples) mingwW64; } // lib.optionalAttrs (system == "x86_64-linux" - && !(nixpkgsName == "R2003" && compiler-nix-name == "ghc884")) { + && !(nixpkgsName == "R2003" && compiler-nix-name == "ghc8104")) { # Musl cross only works on linux # aarch64 cross only works on linux - # We also skip these for the R2003 was build of ghc884 (we only need the + # We also skip these for the R2003 was build of ghc8104 (we only need the # native so ifdLevel 1 includes compiler needed in ifdLevel2 eval) inherit (lib.systems.examples) musl64 aarch64-multiplatform; }; From 7ed00f46b67fdd3ba39e3295f4a1f94fe2de851e Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 22:44:35 +1200 Subject: [PATCH 14/32] Don't run full tests for ghc865 on new nixpkgs --- ci.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ci.nix b/ci.nix index cfe4ec375b..83e6d3fda4 100644 --- a/ci.nix +++ b/ci.nix @@ -27,9 +27,11 @@ ghc865 = true; ghc8104 = false; # Just included because the native version is needed at eval time } // nixpkgs.lib.optionalAttrs (nixpkgsName == "R2009") { + ghc865 = false; ghc884 = true; ghc8104 = true; } // nixpkgs.lib.optionalAttrs (nixpkgsName == "unstable") { + ghc865 = false; ghc884 = false; ghc8104 = true; ghc901 = true; From 482bdc0e80390b0643dafd7b6691d607650c7a53 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 23:30:36 +1200 Subject: [PATCH 15/32] Include patch to fix #1127 --- overlays/bootstrap.nix | 1 + overlays/patches/ghc/AC_PROG_CC_99.patch | 13 +++++++++++++ 2 files changed, 14 insertions(+) create mode 100644 overlays/patches/ghc/AC_PROG_CC_99.patch diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index a623aafb28..7f206a96fa 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -159,6 +159,7 @@ in { ++ fromUntil "8.10.3" "8.10.5" ./patches/ghc/ghc-8.10.3-rts-make-markLiveObject-thread-safe.patch ++ final.lib.optional (versionAtLeast "8.10.4" && final.targetPlatform.isWindows) ./patches/ghc/ghc-8.10-z-drive-fix.patch ++ final.lib.optional (versionAtLeast "8.6.5") ./patches/ghc/ghc-8.10-windows-add-dependent-file.patch + ++ until "8.10.5" ./patches/ghc/AC_PROG_CC_99.patch ; in ({ ghc844 = final.callPackage ../compiler/ghc { diff --git a/overlays/patches/ghc/AC_PROG_CC_99.patch b/overlays/patches/ghc/AC_PROG_CC_99.patch new file mode 100644 index 0000000000..18bd992759 --- /dev/null +++ b/overlays/patches/ghc/AC_PROG_CC_99.patch @@ -0,0 +1,13 @@ +diff --git a/aclocal.m4 b/aclocal.m4 +index 259db63dbff84c91934100a0cb8ff19a0562e90f..99f77d910cfc2421acf3a7d9ac123d79d6daa2ff 100644 +--- a/aclocal.m4 ++++ b/aclocal.m4 +@@ -659,7 +659,7 @@ AC_DEFUN([FP_SET_CFLAGS_C99], + CPPFLAGS="$$3" + unset ac_cv_prog_cc_c99 + dnl perform detection +- _AC_PROG_CC_C99 ++ AC_PROG_CC_C99 + fp_cc_c99="$ac_cv_prog_cc_c99" + case "x$ac_cv_prog_cc_c99" in + x) ;; # noop From d1e8681aad92abbd1a53b44206361f006c576303 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 23:32:29 +1200 Subject: [PATCH 16/32] niv update nixpkgs-unstable --- nix/sources.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index 704a7c6a2e..f9e4751c04 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -149,10 +149,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "5dbd28d75410738ee7a948c7dec9f9cb5a41fa9d", - "sha256": "1amwmy0hihhd9ylr0zbpwr8bmqbh8g003yydzqqckk0ql50dm97x", + "rev": "84aa23742f6c72501f9cc209f29c438766f5352d", + "sha256": "0h7xl6q0yjrbl9vm3h6lkxw692nm8bg3wy65gm95a2mivhrdjpxp", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/5dbd28d75410738ee7a948c7dec9f9cb5a41fa9d.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/84aa23742f6c72501f9cc209f29c438766f5352d.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "old-ghc-nix": { From 006d9e24bdec29a1f6a9fdc91f3b25af60be0d73 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 23:33:41 +1200 Subject: [PATCH 17/32] ifdLevel 0 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index f00eba2ae3..1c8605eed3 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 3 +, ifdLevel ? 0 , checkMaterialization ? false }: let From 028a53348022121c8eadb8991e234f1bedfa8cd7 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 23:39:09 +1200 Subject: [PATCH 18/32] Skip ghc 8.8.4 on nixpkgs-unstable --- ci.nix | 1 - 1 file changed, 1 deletion(-) diff --git a/ci.nix b/ci.nix index 83e6d3fda4..6060ff21f7 100644 --- a/ci.nix +++ b/ci.nix @@ -32,7 +32,6 @@ ghc8104 = true; } // nixpkgs.lib.optionalAttrs (nixpkgsName == "unstable") { ghc865 = false; - ghc884 = false; ghc8104 = true; ghc901 = true; ghc810420210212 = false; From f8b9f7c4194d9c38c30445f3b9ff35d3e34a9d98 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 1 Jun 2021 23:46:46 +1200 Subject: [PATCH 19/32] Avoid possible test dependency on ghc 8.6.4 --- test/call-stack-to-nix/stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/call-stack-to-nix/stack.yaml b/test/call-stack-to-nix/stack.yaml index a240709eb0..47dc26e388 100644 --- a/test/call-stack-to-nix/stack.yaml +++ b/test/call-stack-to-nix/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-13.19 +resolver: lts-14.13 # User packages to be built. # Various formats can be used as shown in the example below. From 8c28a022216512961e8c78772988ad0039025450 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 2 Jun 2021 00:59:32 +1200 Subject: [PATCH 20/32] Include AC_PROG_CC_99 patch for ghc 9.0.1 --- overlays/bootstrap.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index d948c734f5..e7109856ad 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -160,6 +160,7 @@ in { ++ final.lib.optional (versionAtLeast "8.10.4" && final.targetPlatform.isWindows) ./patches/ghc/ghc-8.10-z-drive-fix.patch ++ final.lib.optional (versionAtLeast "8.6.5") ./patches/ghc/ghc-8.10-windows-add-dependent-file.patch ++ until "8.10.5" ./patches/ghc/AC_PROG_CC_99.patch + ++ fromUntil "9.0.1" "9.0.2" ./patches/ghc/AC_PROG_CC_99.patch ; in ({ ghc844 = final.callPackage ../compiler/ghc { From 11f33c046739ed7089c2bd2766ac0aa8c8463770 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 2 Jun 2021 17:19:25 +1200 Subject: [PATCH 21/32] ifdLevel 1 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index 1c8605eed3..ca3de7a550 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 0 +, ifdLevel ? 1 , checkMaterialization ? false }: let From 9e0c325af30b4453d4df95e235930610c27366da Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Sat, 5 Jun 2021 14:40:57 +1200 Subject: [PATCH 22/32] niv update nixpkgs-unstable --- nix/sources.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index f9e4751c04..6142b0b853 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -149,10 +149,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "84aa23742f6c72501f9cc209f29c438766f5352d", - "sha256": "0h7xl6q0yjrbl9vm3h6lkxw692nm8bg3wy65gm95a2mivhrdjpxp", + "rev": "2a1c29ef4bacac06f9b677931027bf053952618c", + "sha256": "1gxkvp4bf222v23kpb7di8iay5gl2qyv5qwgmb10nzdr87avbcax", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/84aa23742f6c72501f9cc209f29c438766f5352d.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/2a1c29ef4bacac06f9b677931027bf053952618c.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "old-ghc-nix": { From 4431028e536d160b32b87db62c4ddb36f267526f Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 7 Jun 2021 20:29:58 +1200 Subject: [PATCH 23/32] niv update nixpkgs-unstable --- nix/sources.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index 6142b0b853..d49d1ac6e6 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -149,10 +149,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "2a1c29ef4bacac06f9b677931027bf053952618c", - "sha256": "1gxkvp4bf222v23kpb7di8iay5gl2qyv5qwgmb10nzdr87avbcax", + "rev": "d8eb97e3801bde96491535f40483d550b57605b9", + "sha256": "1bdd7jinq5d40qai45jfkbcw1n96c7fdlams5iidwzy2ag8axlqh", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/2a1c29ef4bacac06f9b677931027bf053952618c.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/d8eb97e3801bde96491535f40483d550b57605b9.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "old-ghc-nix": { From 7ed10b2e3121b4f7e102c206c632ae027a3eca02 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 7 Jun 2021 20:38:20 +1200 Subject: [PATCH 24/32] Cut back on ghc builds --- ci.nix | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/ci.nix b/ci.nix index 6060ff21f7..2175628b85 100644 --- a/ci.nix +++ b/ci.nix @@ -9,7 +9,6 @@ inherit (import ./ci-lib.nix) dimension platformFilterGeneric filterAttrsOnlyRecursive; sources = import ./nix/sources.nix {}; nixpkgsVersions = { - "R2003" = "nixpkgs-2003"; "R2009" = "nixpkgs-2009"; "unstable" = "nixpkgs-unstable"; }; @@ -24,11 +23,10 @@ # from here (so that is no longer cached) also remove ./materialized/ghcXXX. # Update supported-ghc-versions.md to reflect any changes made here. { - ghc865 = true; + ghc865 = false; ghc8104 = false; # Just included because the native version is needed at eval time } // nixpkgs.lib.optionalAttrs (nixpkgsName == "R2009") { ghc865 = false; - ghc884 = true; ghc8104 = true; } // nixpkgs.lib.optionalAttrs (nixpkgsName == "unstable") { ghc865 = false; @@ -45,15 +43,13 @@ # We need to use the actual nixpkgs version we're working with here, since the values # of 'lib.systems.examples' are not understood between all versions let lib = nixpkgs.lib; - in lib.optionalAttrs (nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc865" "ghc884" "ghc8104"])) { + in lib.optionalAttrs (nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc865" "ghc8104"])) { inherit (lib.systems.examples) ghcjs; - } // lib.optionalAttrs (system == "x86_64-linux" && ( - (nixpkgsName == "R2009" && __elem compiler-nix-name ["ghc8101" "ghc8102" "ghc8103" "ghc8104" "ghc810420210212"]) - || (nixpkgsName == "R2003" && __elem compiler-nix-name ["ghc865"]))) { + } // lib.optionalAttrs (system == "x86_64-linux" && + nixpkgsName "unstable" && (__elem compiler-nix-name ["ghc8101" "ghc8102" "ghc8103" "ghc8104"])) { # Windows cross compilation is currently broken on macOS inherit (lib.systems.examples) mingwW64; - } // lib.optionalAttrs (system == "x86_64-linux" - && !(nixpkgsName == "R2003" && compiler-nix-name == "ghc8104")) { + } // lib.optionalAttrs (system == "x86_64-linux" && nixpkgsName == "unstable" && compiler-nix-name == "ghc8104") { # Musl cross only works on linux # aarch64 cross only works on linux # We also skip these for the R2003 was build of ghc8104 (we only need the From 55c552267eba8eabfe925441bd60b4fdc92e28c3 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 7 Jun 2021 20:46:52 +1200 Subject: [PATCH 25/32] Fix syntax error --- ci.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ci.nix b/ci.nix index 2175628b85..e21fb7eae4 100644 --- a/ci.nix +++ b/ci.nix @@ -46,7 +46,7 @@ in lib.optionalAttrs (nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc865" "ghc8104"])) { inherit (lib.systems.examples) ghcjs; } // lib.optionalAttrs (system == "x86_64-linux" && - nixpkgsName "unstable" && (__elem compiler-nix-name ["ghc8101" "ghc8102" "ghc8103" "ghc8104"])) { + nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8101" "ghc8102" "ghc8103" "ghc8104"])) { # Windows cross compilation is currently broken on macOS inherit (lib.systems.examples) mingwW64; } // lib.optionalAttrs (system == "x86_64-linux" && nixpkgsName == "unstable" && compiler-nix-name == "ghc8104") { From 5ff2bdb944fd1563b0a6737f6a9b53832b08e79d Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 7 Jun 2021 22:48:58 +1200 Subject: [PATCH 26/32] Add ghc 8.8.4 native (used to boot 9.0.1). Remove ghcjs 8.6. --- ci.nix | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ci.nix b/ci.nix index e21fb7eae4..10b2ea700c 100644 --- a/ci.nix +++ b/ci.nix @@ -30,6 +30,7 @@ ghc8104 = true; } // nixpkgs.lib.optionalAttrs (nixpkgsName == "unstable") { ghc865 = false; + ghc884 = false; # Native version is used to boot 9.0.1 ghc8104 = true; ghc901 = true; ghc810420210212 = false; @@ -43,7 +44,7 @@ # We need to use the actual nixpkgs version we're working with here, since the values # of 'lib.systems.examples' are not understood between all versions let lib = nixpkgs.lib; - in lib.optionalAttrs (nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc865" "ghc8104"])) { + in lib.optionalAttrs (nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8104"])) { inherit (lib.systems.examples) ghcjs; } // lib.optionalAttrs (system == "x86_64-linux" && nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8101" "ghc8102" "ghc8103" "ghc8104"])) { From 88b2d9f71e8c394f300f32cca00811cb852f7686 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 8 Jun 2021 14:34:41 +1200 Subject: [PATCH 27/32] Fix AC_PROG_CC_C99 issue in ghcjs --- lib/ghcjs-project.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/ghcjs-project.nix b/lib/ghcjs-project.nix index 0e61a65b99..a2ff96e44f 100644 --- a/lib/ghcjs-project.nix +++ b/lib/ghcjs-project.nix @@ -115,6 +115,8 @@ let cp ${../overlays/patches/config.sub} ghc/libraries/base/config.sub cp ${../overlays/patches/config.sub} ghc/libraries/unix/config.sub + sed -i 's/_AC_PROG_CC_C99/AC_PROG_CC_C99/' ghc/aclocal.m4 + patchShebangs . sed -i 's/gcc /cc /g' utils/makePackages.sh ./utils/makePackages.sh copy From 7cba3df12f7f4616efb8dcca4268a84b2e5b1c13 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 8 Jun 2021 17:21:08 +1200 Subject: [PATCH 28/32] Add ghc 8.10.5 --- .buildkite/pipeline.yml | 10 +- ci.nix | 14 +- overlays/bootstrap.nix | 39 +- overlays/patches/ghc/ghc-8.10.5-ubxt.patch | 7884 ++++++++++++++++++++ release.nix | 4 +- 5 files changed, 7927 insertions(+), 24 deletions(-) create mode 100644 overlays/patches/ghc/ghc-8.10.5-ubxt.patch diff --git a/.buildkite/pipeline.yml b/.buildkite/pipeline.yml index e37bc9861b..68c34a3b76 100644 --- a/.buildkite/pipeline.yml +++ b/.buildkite/pipeline.yml @@ -1,6 +1,6 @@ steps: - - label: 'Run tests with ghc8104' - command: "./test/tests.sh ghc8104" + - label: 'Run tests with ghc8105' + command: "./test/tests.sh ghc8105" agents: system: x86_64-linux @@ -14,9 +14,9 @@ steps: agents: system: x86_64-linux - - label: 'Check closure size with ghc8104' + - label: 'Check closure size with ghc8105' command: - - nix-build build.nix -A maintainer-scripts.check-closure-size --argstr compiler-nix-name ghc8104 -o check-closure-size.sh + - nix-build build.nix -A maintainer-scripts.check-closure-size --argstr compiler-nix-name ghc8105 -o check-closure-size.sh - echo "+++ Closure size (MB)" - ./check-closure-size.sh agents: @@ -36,5 +36,5 @@ steps: - label: 'Make sure non store paths like can be used as src' command: - - nix-build build.nix -A maintainer-scripts.check-path-support --argstr compiler-nix-name ghc884 -o check-path-support.sh + - nix-build build.nix -A maintainer-scripts.check-path-support --argstr compiler-nix-name ghc8105 -o check-path-support.sh - ./check-path-support.sh diff --git a/ci.nix b/ci.nix index 10b2ea700c..4c004c5086 100644 --- a/ci.nix +++ b/ci.nix @@ -24,14 +24,14 @@ # Update supported-ghc-versions.md to reflect any changes made here. { ghc865 = false; - ghc8104 = false; # Just included because the native version is needed at eval time + ghc8105 = false; # Just included because the native version is needed at eval time } // nixpkgs.lib.optionalAttrs (nixpkgsName == "R2009") { ghc865 = false; - ghc8104 = true; + ghc8105 = true; } // nixpkgs.lib.optionalAttrs (nixpkgsName == "unstable") { ghc865 = false; ghc884 = false; # Native version is used to boot 9.0.1 - ghc8104 = true; + ghc8105 = true; ghc901 = true; ghc810420210212 = false; }); @@ -44,17 +44,15 @@ # We need to use the actual nixpkgs version we're working with here, since the values # of 'lib.systems.examples' are not understood between all versions let lib = nixpkgs.lib; - in lib.optionalAttrs (nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8104"])) { + in lib.optionalAttrs (nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8105"])) { inherit (lib.systems.examples) ghcjs; } // lib.optionalAttrs (system == "x86_64-linux" && - nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8101" "ghc8102" "ghc8103" "ghc8104"])) { + nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8105"])) { # Windows cross compilation is currently broken on macOS inherit (lib.systems.examples) mingwW64; - } // lib.optionalAttrs (system == "x86_64-linux" && nixpkgsName == "unstable" && compiler-nix-name == "ghc8104") { + } // lib.optionalAttrs (system == "x86_64-linux" && nixpkgsName == "unstable" && compiler-nix-name == "ghc8105") { # Musl cross only works on linux # aarch64 cross only works on linux - # We also skip these for the R2003 was build of ghc8104 (we only need the - # native so ifdLevel 1 includes compiler needed in ifdLevel2 eval) inherit (lib.systems.examples) musl64 aarch64-multiplatform; }; isDisabled = d: d.meta.disabled or false; diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index 59838b7945..e893ce3ed0 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -44,7 +44,7 @@ let latestVer = { "8.6" = "8.6.5"; "8.8" = "8.8.4"; - "8.10" = "8.10.4"; + "8.10" = "8.10.5"; }; traceWarnOld = v: x: __trace "WARNING: ${x.src-spec.version} is out of date, consider using ${latestVer.${v}}." x; @@ -153,7 +153,8 @@ in { ++ from "8.10.1" ./patches/ghc/ghc-acrt-iob-func.patch ++ fromUntil "8.10.1" "8.10.3" ./patches/ghc/ghc-8.10-ubxt.patch - ++ fromUntil "8.10.3" "8.11" ./patches/ghc/ghc-8.10.3-ubxt.patch + ++ fromUntil "8.10.3" "8.10.5" ./patches/ghc/ghc-8.10.3-ubxt.patch + ++ fromUntil "8.10.5" "8.11" ./patches/ghc/ghc-8.10.5-ubxt.patch ++ final.lib.optional (versionAtLeast "8.6.4") ./patches/ghc/Cabal-3886.patch ++ fromUntil "8.10.3" "8.10.5" ./patches/ghc/ghc-8.10.3-rts-make-markLiveObject-thread-safe.patch @@ -434,6 +435,26 @@ in { ghc-patches = ghc-patches "8.10.4"; }; + ghc8105 = final.callPackage ../compiler/ghc { + extra-passthru = { buildGHC = final.buildPackages.haskell-nix.compiler.ghc8105; }; + + bootPkgs = bootPkgs // { + # Not using 8.8 due to https://gitlab.haskell.org/ghc/ghc/-/issues/18143 + ghc = final.buildPackages.buildPackages.haskell-nix.compiler.ghc865; + }; + inherit sphinx installDeps; + + buildLlvmPackages = final.buildPackages.llvmPackages_9; + llvmPackages = final.llvmPackages_9; + + src-spec = rec { + version = "8.10.5"; + url = "https://downloads.haskell.org/~ghc/${version}/ghc-${version}-src.tar.xz"; + sha256 = "0vq7wch0wfvy2b5dbi308lq5225vf691n95m19c9igagdvql22gi"; + }; + + ghc-patches = ghc-patches "8.10.5"; + }; ghc901 = final.callPackage ../compiler/ghc { extra-passthru = { buildGHC = final.buildPackages.haskell-nix.compiler.ghc901; }; @@ -590,18 +611,18 @@ in { cd lib lndir ${ghcjs884}/lib ${targetPrefix}ghc-8.8.4 '' + installDeps targetPrefix); - ghc8104 = let buildGHC = final.buildPackages.haskell-nix.compiler.ghc8104; + ghc8105 = let buildGHC = final.buildPackages.haskell-nix.compiler.ghc8105; in let ghcjs8104 = final.callPackage ../compiler/ghcjs/ghcjs.nix { ghcjsSrcJson = ../compiler/ghcjs/ghcjs810-src.json; ghcjsVersion = "8.10.2"; ghc = buildGHC; - ghcVersion = "8.10.4"; - compiler-nix-name = "ghc8104"; - }; in let targetPrefix = "js-unknown-ghcjs-"; in final.runCommand "${targetPrefix}ghc-8.10.4" { + ghcVersion = "8.10.5"; + compiler-nix-name = "ghc8105"; + }; in let targetPrefix = "js-unknown-ghcjs-"; in final.runCommand "${targetPrefix}ghc-8.10.5" { nativeBuildInputs = [ final.xorg.lndir ]; passthru = { inherit targetPrefix; - version = "8.10.4"; + version = "8.10.5"; isHaskellNixCompiler = true; enableShared = false; inherit (ghcjs8104) configured-src bundled-ghcjs project; @@ -620,9 +641,9 @@ in { ln -s ${ghcjs8104}/bin/ghcjs-pkg ${targetPrefix}ghc-pkg ln -s ${buildGHC}/bin/hsc2hs ${targetPrefix}hsc2hs cd .. - mkdir -p lib/${targetPrefix}ghc-8.10.4 + mkdir -p lib/${targetPrefix}ghc-8.10.5 cd lib - lndir ${ghcjs8104}/lib ${targetPrefix}ghc-8.10.4 + lndir ${ghcjs8104}/lib ${targetPrefix}ghc-8.10.5 '' + installDeps targetPrefix); })))); diff --git a/overlays/patches/ghc/ghc-8.10.5-ubxt.patch b/overlays/patches/ghc/ghc-8.10.5-ubxt.patch new file mode 100644 index 0000000000..c6aff4c871 --- /dev/null +++ b/overlays/patches/ghc/ghc-8.10.5-ubxt.patch @@ -0,0 +1,7884 @@ +diff --git a/compiler/GHC/Core/Map/Expr.hs b/compiler/GHC/Core/Map/Expr.hs +new file mode 100644 +index 0000000000..04c786deec +--- /dev/null ++++ b/compiler/GHC/Core/Map/Expr.hs +@@ -0,0 +1,392 @@ ++{-# LANGUAGE CPP #-} ++{-# LANGUAGE FlexibleContexts #-} ++{-# LANGUAGE FlexibleInstances #-} ++{-# LANGUAGE RankNTypes #-} ++{-# LANGUAGE ScopedTypeVariables #-} ++{-# LANGUAGE TypeFamilies #-} ++{-# LANGUAGE UndecidableInstances #-} ++ ++{- ++(c) The University of Glasgow 2006 ++(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 ++-} ++ ++{-# OPTIONS_GHC -Wno-orphans #-} ++ -- Eq (DeBruijn CoreExpr) and Eq (DeBruijn CoreAlt) ++ ++module GHC.Core.Map.Expr ( ++ -- * Maps over Core expressions ++ CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, ++ -- * 'TrieMap' class reexports ++ TrieMap(..), insertTM, deleteTM, ++ lkDFreeVar, xtDFreeVar, ++ lkDNamed, xtDNamed, ++ (>.>), (|>), (|>>), ++ ) where ++ ++#include "HsVersions.h" ++ ++import GHC.Prelude ++ ++import GHC.Data.TrieMap ++import GHC.Core.Map.Type ++import GHC.Core ++import GHC.Core.Type ++import GHC.Types.Var ++ ++import GHC.Utils.Misc ++import GHC.Utils.Outputable ++ ++import qualified Data.Map as Map ++import GHC.Types.Name.Env ++import Control.Monad( (>=>) ) ++ ++{- ++This module implements TrieMaps over Core related data structures ++like CoreExpr or Type. It is built on the Tries from the TrieMap ++module. ++ ++The code is very regular and boilerplate-like, but there is ++some neat handling of *binders*. In effect they are deBruijn ++numbered on the fly. ++ ++ ++-} ++ ++---------------------- ++-- Recall that ++-- Control.Monad.(>=>) :: (a -> Maybe b) -> (b -> Maybe c) -> a -> Maybe c ++ ++-- The CoreMap makes heavy use of GenMap. However the CoreMap Types are not ++-- known when defining GenMap so we can only specialize them here. ++ ++{-# SPECIALIZE lkG :: Key CoreMapX -> CoreMapG a -> Maybe a #-} ++{-# SPECIALIZE xtG :: Key CoreMapX -> XT a -> CoreMapG a -> CoreMapG a #-} ++{-# SPECIALIZE mapG :: (a -> b) -> CoreMapG a -> CoreMapG b #-} ++{-# SPECIALIZE fdG :: (a -> b -> b) -> CoreMapG a -> b -> b #-} ++ ++ ++{- ++************************************************************************ ++* * ++ CoreMap ++* * ++************************************************************************ ++-} ++ ++{- ++Note [Binders] ++~~~~~~~~~~~~~~ ++ * In general we check binders as late as possible because types are ++ less likely to differ than expression structure. That's why ++ cm_lam :: CoreMapG (TypeMapG a) ++ rather than ++ cm_lam :: TypeMapG (CoreMapG a) ++ ++ * We don't need to look at the type of some binders, notably ++ - the case binder in (Case _ b _ _) ++ - the binders in an alternative ++ because they are totally fixed by the context ++ ++Note [Empty case alternatives] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++* For a key (Case e b ty (alt:alts)) we don't need to look the return type ++ 'ty', because every alternative has that type. ++ ++* For a key (Case e b ty []) we MUST look at the return type 'ty', because ++ otherwise (Case (error () "urk") _ Int []) would compare equal to ++ (Case (error () "urk") _ Bool []) ++ which is utterly wrong (#6097) ++ ++We could compare the return type regardless, but the wildly common case ++is that it's unnecessary, so we have two fields (cm_case and cm_ecase) ++for the two possibilities. Only cm_ecase looks at the type. ++ ++See also Note [Empty case alternatives] in GHC.Core. ++-} ++ ++-- | @CoreMap a@ is a map from 'CoreExpr' to @a@. If you are a client, this ++-- is the type you want. ++newtype CoreMap a = CoreMap (CoreMapG a) ++ ++instance TrieMap CoreMap where ++ type Key CoreMap = CoreExpr ++ emptyTM = CoreMap emptyTM ++ lookupTM k (CoreMap m) = lookupTM (deBruijnize k) m ++ alterTM k f (CoreMap m) = CoreMap (alterTM (deBruijnize k) f m) ++ foldTM k (CoreMap m) = foldTM k m ++ mapTM f (CoreMap m) = CoreMap (mapTM f m) ++ filterTM f (CoreMap m) = CoreMap (filterTM f m) ++ ++-- | @CoreMapG a@ is a map from @DeBruijn CoreExpr@ to @a@. The extended ++-- key makes it suitable for recursive traversal, since it can track binders, ++-- but it is strictly internal to this module. If you are including a 'CoreMap' ++-- inside another 'TrieMap', this is the type you want. ++type CoreMapG = GenMap CoreMapX ++ ++-- | @CoreMapX a@ is the base map from @DeBruijn CoreExpr@ to @a@, but without ++-- the 'GenMap' optimization. ++data CoreMapX a ++ = CM { cm_var :: VarMap a ++ , cm_lit :: LiteralMap a ++ , cm_co :: CoercionMapG a ++ , cm_type :: TypeMapG a ++ , cm_cast :: CoreMapG (CoercionMapG a) ++ , cm_tick :: CoreMapG (TickishMap a) ++ , cm_app :: CoreMapG (CoreMapG a) ++ , cm_lam :: CoreMapG (BndrMap a) -- Note [Binders] ++ , cm_letn :: CoreMapG (CoreMapG (BndrMap a)) ++ , cm_letr :: ListMap CoreMapG (CoreMapG (ListMap BndrMap a)) ++ , cm_case :: CoreMapG (ListMap AltMap a) ++ , cm_ecase :: CoreMapG (TypeMapG a) -- Note [Empty case alternatives] ++ } ++ ++instance Eq (DeBruijn CoreExpr) where ++ D env1 e1 == D env2 e2 = go e1 e2 where ++ go (Var v1) (Var v2) ++ = case (lookupCME env1 v1, lookupCME env2 v2) of ++ (Just b1, Just b2) -> b1 == b2 ++ (Nothing, Nothing) -> v1 == v2 ++ _ -> False ++ go (Lit lit1) (Lit lit2) = lit1 == lit2 ++ go (Type t1) (Type t2) = D env1 t1 == D env2 t2 ++ go (Coercion co1) (Coercion co2) = D env1 co1 == D env2 co2 ++ go (Cast e1 co1) (Cast e2 co2) = D env1 co1 == D env2 co2 && go e1 e2 ++ go (App f1 a1) (App f2 a2) = go f1 f2 && go a1 a2 ++ -- This seems a bit dodgy, see 'eqTickish' ++ go (Tick n1 e1) (Tick n2 e2) = n1 == n2 && go e1 e2 ++ ++ go (Lam b1 e1) (Lam b2 e2) ++ = D env1 (varType b1) == D env2 (varType b2) ++ && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) ++ && D (extendCME env1 b1) e1 == D (extendCME env2 b2) e2 ++ ++ go (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2) ++ = go r1 r2 ++ && D (extendCME env1 v1) e1 == D (extendCME env2 v2) e2 ++ ++ go (Let (Rec ps1) e1) (Let (Rec ps2) e2) ++ = equalLength ps1 ps2 ++ && D env1' rs1 == D env2' rs2 ++ && D env1' e1 == D env2' e2 ++ where ++ (bs1,rs1) = unzip ps1 ++ (bs2,rs2) = unzip ps2 ++ env1' = extendCMEs env1 bs1 ++ env2' = extendCMEs env2 bs2 ++ ++ go (Case e1 b1 t1 a1) (Case e2 b2 t2 a2) ++ | null a1 -- See Note [Empty case alternatives] ++ = null a2 && go e1 e2 && D env1 t1 == D env2 t2 ++ | otherwise ++ = go e1 e2 && D (extendCME env1 b1) a1 == D (extendCME env2 b2) a2 ++ ++ go _ _ = False ++ ++emptyE :: CoreMapX a ++emptyE = CM { cm_var = emptyTM, cm_lit = emptyTM ++ , cm_co = emptyTM, cm_type = emptyTM ++ , cm_cast = emptyTM, cm_app = emptyTM ++ , cm_lam = emptyTM, cm_letn = emptyTM ++ , cm_letr = emptyTM, cm_case = emptyTM ++ , cm_ecase = emptyTM, cm_tick = emptyTM } ++ ++instance TrieMap CoreMapX where ++ type Key CoreMapX = DeBruijn CoreExpr ++ emptyTM = emptyE ++ lookupTM = lkE ++ alterTM = xtE ++ foldTM = fdE ++ mapTM = mapE ++ filterTM = ftE ++ ++-------------------------- ++mapE :: (a->b) -> CoreMapX a -> CoreMapX b ++mapE f (CM { cm_var = cvar, cm_lit = clit ++ , cm_co = cco, cm_type = ctype ++ , cm_cast = ccast , cm_app = capp ++ , cm_lam = clam, cm_letn = cletn ++ , cm_letr = cletr, cm_case = ccase ++ , cm_ecase = cecase, cm_tick = ctick }) ++ = CM { cm_var = mapTM f cvar, cm_lit = mapTM f clit ++ , cm_co = mapTM f cco, cm_type = mapTM f ctype ++ , cm_cast = mapTM (mapTM f) ccast, cm_app = mapTM (mapTM f) capp ++ , cm_lam = mapTM (mapTM f) clam, cm_letn = mapTM (mapTM (mapTM f)) cletn ++ , cm_letr = mapTM (mapTM (mapTM f)) cletr, cm_case = mapTM (mapTM f) ccase ++ , cm_ecase = mapTM (mapTM f) cecase, cm_tick = mapTM (mapTM f) ctick } ++ ++ftE :: (a->Bool) -> CoreMapX a -> CoreMapX a ++ftE f (CM { cm_var = cvar, cm_lit = clit ++ , cm_co = cco, cm_type = ctype ++ , cm_cast = ccast , cm_app = capp ++ , cm_lam = clam, cm_letn = cletn ++ , cm_letr = cletr, cm_case = ccase ++ , cm_ecase = cecase, cm_tick = ctick }) ++ = CM { cm_var = filterTM f cvar, cm_lit = filterTM f clit ++ , cm_co = filterTM f cco, cm_type = filterTM f ctype ++ , cm_cast = mapTM (filterTM f) ccast, cm_app = mapTM (filterTM f) capp ++ , cm_lam = mapTM (filterTM f) clam, cm_letn = mapTM (mapTM (filterTM f)) cletn ++ , cm_letr = mapTM (mapTM (filterTM f)) cletr, cm_case = mapTM (filterTM f) ccase ++ , cm_ecase = mapTM (filterTM f) cecase, cm_tick = mapTM (filterTM f) ctick } ++ ++-------------------------- ++lookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a ++lookupCoreMap cm e = lookupTM e cm ++ ++extendCoreMap :: CoreMap a -> CoreExpr -> a -> CoreMap a ++extendCoreMap m e v = alterTM e (\_ -> Just v) m ++ ++foldCoreMap :: (a -> b -> b) -> b -> CoreMap a -> b ++foldCoreMap k z m = foldTM k m z ++ ++emptyCoreMap :: CoreMap a ++emptyCoreMap = emptyTM ++ ++instance Outputable a => Outputable (CoreMap a) where ++ ppr m = text "CoreMap elts" <+> ppr (foldTM (:) m []) ++ ++------------------------- ++fdE :: (a -> b -> b) -> CoreMapX a -> b -> b ++fdE k m ++ = foldTM k (cm_var m) ++ . foldTM k (cm_lit m) ++ . foldTM k (cm_co m) ++ . foldTM k (cm_type m) ++ . foldTM (foldTM k) (cm_cast m) ++ . foldTM (foldTM k) (cm_tick m) ++ . foldTM (foldTM k) (cm_app m) ++ . foldTM (foldTM k) (cm_lam m) ++ . foldTM (foldTM (foldTM k)) (cm_letn m) ++ . foldTM (foldTM (foldTM k)) (cm_letr m) ++ . foldTM (foldTM k) (cm_case m) ++ . foldTM (foldTM k) (cm_ecase m) ++ ++-- lkE: lookup in trie for expressions ++lkE :: DeBruijn CoreExpr -> CoreMapX a -> Maybe a ++lkE (D env expr) cm = go expr cm ++ where ++ go (Var v) = cm_var >.> lkVar env v ++ go (Lit l) = cm_lit >.> lookupTM l ++ go (Type t) = cm_type >.> lkG (D env t) ++ go (Coercion c) = cm_co >.> lkG (D env c) ++ go (Cast e c) = cm_cast >.> lkG (D env e) >=> lkG (D env c) ++ go (Tick tickish e) = cm_tick >.> lkG (D env e) >=> lkTickish tickish ++ go (App e1 e2) = cm_app >.> lkG (D env e2) >=> lkG (D env e1) ++ go (Lam v e) = cm_lam >.> lkG (D (extendCME env v) e) ++ >=> lkBndr env v ++ go (Let (NonRec b r) e) = cm_letn >.> lkG (D env r) ++ >=> lkG (D (extendCME env b) e) >=> lkBndr env b ++ go (Let (Rec prs) e) = let (bndrs,rhss) = unzip prs ++ env1 = extendCMEs env bndrs ++ in cm_letr ++ >.> lkList (lkG . D env1) rhss ++ >=> lkG (D env1 e) ++ >=> lkList (lkBndr env1) bndrs ++ go (Case e b ty as) -- See Note [Empty case alternatives] ++ | null as = cm_ecase >.> lkG (D env e) >=> lkG (D env ty) ++ | otherwise = cm_case >.> lkG (D env e) ++ >=> lkList (lkA (extendCME env b)) as ++ ++xtE :: DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a ++xtE (D env (Var v)) f m = m { cm_var = cm_var m ++ |> xtVar env v f } ++xtE (D env (Type t)) f m = m { cm_type = cm_type m ++ |> xtG (D env t) f } ++xtE (D env (Coercion c)) f m = m { cm_co = cm_co m ++ |> xtG (D env c) f } ++xtE (D _ (Lit l)) f m = m { cm_lit = cm_lit m |> alterTM l f } ++xtE (D env (Cast e c)) f m = m { cm_cast = cm_cast m |> xtG (D env e) ++ |>> xtG (D env c) f } ++xtE (D env (Tick t e)) f m = m { cm_tick = cm_tick m |> xtG (D env e) ++ |>> xtTickish t f } ++xtE (D env (App e1 e2)) f m = m { cm_app = cm_app m |> xtG (D env e2) ++ |>> xtG (D env e1) f } ++xtE (D env (Lam v e)) f m = m { cm_lam = cm_lam m ++ |> xtG (D (extendCME env v) e) ++ |>> xtBndr env v f } ++xtE (D env (Let (NonRec b r) e)) f m = m { cm_letn = cm_letn m ++ |> xtG (D (extendCME env b) e) ++ |>> xtG (D env r) ++ |>> xtBndr env b f } ++xtE (D env (Let (Rec prs) e)) f m = m { cm_letr = ++ let (bndrs,rhss) = unzip prs ++ env1 = extendCMEs env bndrs ++ in cm_letr m ++ |> xtList (xtG . D env1) rhss ++ |>> xtG (D env1 e) ++ |>> xtList (xtBndr env1) ++ bndrs f } ++xtE (D env (Case e b ty as)) f m ++ | null as = m { cm_ecase = cm_ecase m |> xtG (D env e) ++ |>> xtG (D env ty) f } ++ | otherwise = m { cm_case = cm_case m |> xtG (D env e) ++ |>> let env1 = extendCME env b ++ in xtList (xtA env1) as f } ++ ++-- TODO: this seems a bit dodgy, see 'eqTickish' ++type TickishMap a = Map.Map CoreTickish a ++lkTickish :: CoreTickish -> TickishMap a -> Maybe a ++lkTickish = lookupTM ++ ++xtTickish :: CoreTickish -> XT a -> TickishMap a -> TickishMap a ++xtTickish = alterTM ++ ++------------------------ ++data AltMap a -- A single alternative ++ = AM { am_deflt :: CoreMapG a ++ , am_data :: DNameEnv (CoreMapG a) ++ , am_lit :: LiteralMap (CoreMapG a) } ++ ++instance TrieMap AltMap where ++ type Key AltMap = CoreAlt ++ emptyTM = AM { am_deflt = emptyTM ++ , am_data = emptyDNameEnv ++ , am_lit = emptyTM } ++ lookupTM = lkA emptyCME ++ alterTM = xtA emptyCME ++ foldTM = fdA ++ mapTM = mapA ++ filterTM = ftA ++ ++instance Eq (DeBruijn CoreAlt) where ++ D env1 a1 == D env2 a2 = go a1 a2 where ++ go (Alt DEFAULT _ rhs1) (Alt DEFAULT _ rhs2) ++ = D env1 rhs1 == D env2 rhs2 ++ go (Alt (LitAlt lit1) _ rhs1) (Alt (LitAlt lit2) _ rhs2) ++ = lit1 == lit2 && D env1 rhs1 == D env2 rhs2 ++ go (Alt (DataAlt dc1) bs1 rhs1) (Alt (DataAlt dc2) bs2 rhs2) ++ = dc1 == dc2 && ++ D (extendCMEs env1 bs1) rhs1 == D (extendCMEs env2 bs2) rhs2 ++ go _ _ = False ++ ++mapA :: (a->b) -> AltMap a -> AltMap b ++mapA f (AM { am_deflt = adeflt, am_data = adata, am_lit = alit }) ++ = AM { am_deflt = mapTM f adeflt ++ , am_data = mapTM (mapTM f) adata ++ , am_lit = mapTM (mapTM f) alit } ++ ++ftA :: (a->Bool) -> AltMap a -> AltMap a ++ftA f (AM { am_deflt = adeflt, am_data = adata, am_lit = alit }) ++ = AM { am_deflt = filterTM f adeflt ++ , am_data = mapTM (filterTM f) adata ++ , am_lit = mapTM (filterTM f) alit } ++ ++lkA :: CmEnv -> CoreAlt -> AltMap a -> Maybe a ++lkA env (Alt DEFAULT _ rhs) = am_deflt >.> lkG (D env rhs) ++lkA env (Alt (LitAlt lit) _ rhs) = am_lit >.> lookupTM lit >=> lkG (D env rhs) ++lkA env (Alt (DataAlt dc) bs rhs) = am_data >.> lkDNamed dc ++ >=> lkG (D (extendCMEs env bs) rhs) ++ ++xtA :: CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a ++xtA env (Alt DEFAULT _ rhs) f m = ++ m { am_deflt = am_deflt m |> xtG (D env rhs) f } ++xtA env (Alt (LitAlt l) _ rhs) f m = ++ m { am_lit = am_lit m |> alterTM l |>> xtG (D env rhs) f } ++xtA env (Alt (DataAlt d) bs rhs) f m = ++ m { am_data = am_data m |> xtDNamed d ++ |>> xtG (D (extendCMEs env bs) rhs) f } ++ ++fdA :: (a -> b -> b) -> AltMap a -> b -> b ++fdA k m = foldTM k (am_deflt m) ++ . foldTM (foldTM k) (am_data m) ++ . foldTM (foldTM k) (am_lit m) +diff --git a/compiler/GHC/Core/Opt/CallerCC.hs b/compiler/GHC/Core/Opt/CallerCC.hs +new file mode 100644 +index 0000000000..68875dc18f +--- /dev/null ++++ b/compiler/GHC/Core/Opt/CallerCC.hs +@@ -0,0 +1,223 @@ ++{-# LANGUAGE NamedFieldPuns #-} ++{-# LANGUAGE TypeApplications #-} ++{-# LANGUAGE DeriveGeneric #-} ++{-# LANGUAGE DeriveDataTypeable #-} ++{-# LANGUAGE DeriveAnyClass #-} ++{-# LANGUAGE DerivingStrategies #-} ++{-# LANGUAGE TupleSections #-} ++ ++-- | Adds cost-centers to call sites selected with the @-fprof-caller=...@ ++-- flag. ++module GHC.Core.Opt.CallerCC ++ ( addCallerCostCentres ++ , CallerCcFilter ++ , parseCallerCcFilter ++ ) where ++ ++import Data.Bifunctor ++import Data.Word (Word8) ++import Data.Maybe ++import qualified Text.Parsec as P ++ ++import Control.Applicative ++import Control.Monad.Trans.State.Strict ++import Data.Either ++import Control.Monad ++ ++import GHC.Prelude ++import GHC.Utils.Outputable as Outputable ++import GHC.Driver.Session ++import GHC.Driver.Ppr ++import GHC.Types.CostCentre ++import GHC.Types.CostCentre.State ++import GHC.Types.Name hiding (varName) ++import GHC.Unit.Module.Name ++import GHC.Unit.Module.ModGuts ++import GHC.Types.SrcLoc ++import GHC.Types.Var ++import GHC.Unit.Types ++import GHC.Data.FastString ++import GHC.Core ++import GHC.Core.Opt.Monad ++import GHC.Utils.Panic ++import qualified GHC.Utils.Binary as B ++ ++addCallerCostCentres :: ModGuts -> CoreM ModGuts ++addCallerCostCentres guts = do ++ dflags <- getDynFlags ++ let filters = callerCcFilters dflags ++ let env :: Env ++ env = Env ++ { thisModule = mg_module guts ++ , ccState = newCostCentreState ++ , dflags = dflags ++ , revParents = [] ++ , filters = filters ++ } ++ let guts' = guts { mg_binds = doCoreProgram env (mg_binds guts) ++ } ++ return guts' ++ ++doCoreProgram :: Env -> CoreProgram -> CoreProgram ++doCoreProgram env binds = flip evalState newCostCentreState $ do ++ mapM (doBind env) binds ++ ++doBind :: Env -> CoreBind -> M CoreBind ++doBind env (NonRec b rhs) = NonRec b <$> doExpr (addParent b env) rhs ++doBind env (Rec bs) = Rec <$> mapM doPair bs ++ where ++ doPair (b,rhs) = (b,) <$> doExpr (addParent b env) rhs ++ ++doExpr :: Env -> CoreExpr -> M CoreExpr ++doExpr env e@(Var v) ++ | needsCallSiteCostCentre env v = do ++ let nameDoc :: SDoc ++ nameDoc = withUserStyle alwaysQualify DefaultDepth $ ++ hcat (punctuate dot (map ppr (parents env))) <> parens (text "calling:" <> ppr v) ++ ++ ccName :: CcName ++ ccName = mkFastString $ showSDoc (dflags env) nameDoc ++ ccIdx <- getCCIndex' ccName ++ let span = case revParents env of ++ top:_ -> nameSrcSpan $ varName top ++ _ -> noSrcSpan ++ cc = NormalCC (ExprCC ccIdx) ccName (thisModule env) span ++ tick :: CoreTickish ++ tick = ProfNote cc True True ++ pure $ Tick tick e ++ | otherwise = pure e ++doExpr _env e@(Lit _) = pure e ++doExpr env (f `App` x) = App <$> doExpr env f <*> doExpr env x ++doExpr env (Lam b x) = Lam b <$> doExpr env x ++doExpr env (Let b rhs) = Let <$> doBind env b <*> doExpr env rhs ++doExpr env (Case scrut b ty alts) = ++ Case <$> doExpr env scrut <*> pure b <*> pure ty <*> mapM doAlt alts ++ where ++ doAlt (Alt con bs rhs) = Alt con bs <$> doExpr env rhs ++doExpr env (Cast expr co) = Cast <$> doExpr env expr <*> pure co ++doExpr env (Tick t e) = Tick t <$> doExpr env e ++doExpr _env e@(Type _) = pure e ++doExpr _env e@(Coercion _) = pure e ++ ++type M = State CostCentreState ++ ++getCCIndex' :: FastString -> M CostCentreIndex ++getCCIndex' name = state (getCCIndex name) ++ ++data Env = Env ++ { thisModule :: Module ++ , dflags :: DynFlags ++ , ccState :: CostCentreState ++ , revParents :: [Id] ++ , filters :: [CallerCcFilter] ++ } ++ ++addParent :: Id -> Env -> Env ++addParent i env = env { revParents = i : revParents env } ++ ++parents :: Env -> [Id] ++parents env = reverse (revParents env) ++ ++needsCallSiteCostCentre :: Env -> Id -> Bool ++needsCallSiteCostCentre env i = ++ any matches (filters env) ++ where ++ matches :: CallerCcFilter -> Bool ++ matches ccf = ++ checkModule && checkFunc ++ where ++ checkModule = ++ case ccfModuleName ccf of ++ Just modFilt ++ | Just iMod <- nameModule_maybe (varName i) ++ -> moduleName iMod == modFilt ++ | otherwise -> False ++ Nothing -> True ++ checkFunc = ++ occNameMatches (ccfFuncName ccf) (getOccName i) ++ ++data NamePattern ++ = PChar Char NamePattern ++ | PWildcard NamePattern ++ | PEnd ++ ++instance Outputable NamePattern where ++ ppr (PChar c rest) = char c <> ppr rest ++ ppr (PWildcard rest) = char '*' <> ppr rest ++ ppr PEnd = Outputable.empty ++ ++instance B.Binary NamePattern where ++ get bh = do ++ tag <- B.get bh ++ case tag :: Word8 of ++ 0 -> PChar <$> B.get bh <*> B.get bh ++ 1 -> PWildcard <$> B.get bh ++ 2 -> pure PEnd ++ _ -> panic "Binary(NamePattern): Invalid tag" ++ put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y ++ put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x ++ put_ bh PEnd = B.put_ bh (2 :: Word8) ++ ++occNameMatches :: NamePattern -> OccName -> Bool ++occNameMatches pat = go pat . occNameString ++ where ++ go :: NamePattern -> String -> Bool ++ go PEnd "" = True ++ go (PChar c rest) (d:s) ++ = d == c && go rest s ++ go (PWildcard rest) s ++ = go rest s || go (PWildcard rest) (tail s) ++ go _ _ = False ++ ++type Parser = P.Parsec String () ++ ++parseNamePattern :: Parser NamePattern ++parseNamePattern = pattern ++ where ++ pattern = star <|> wildcard <|> char <|> end ++ star = PChar '*' <$ P.string "\\*" <*> pattern ++ wildcard = do ++ void $ P.char '*' ++ PWildcard <$> pattern ++ char = PChar <$> P.anyChar <*> pattern ++ end = PEnd <$ P.eof ++ ++data CallerCcFilter ++ = CallerCcFilter { ccfModuleName :: Maybe ModuleName ++ , ccfFuncName :: NamePattern ++ } ++ ++instance Outputable CallerCcFilter where ++ ppr ccf = ++ maybe (char '*') ppr (ccfModuleName ccf) ++ <> char '.' ++ <> ppr (ccfFuncName ccf) ++ ++instance B.Binary CallerCcFilter where ++ get bh = CallerCcFilter <$> B.get bh <*> B.get bh ++ put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y ++ ++parseCallerCcFilter :: String -> Either String CallerCcFilter ++parseCallerCcFilter = ++ first show . P.parse parseCallerCcFilter' "caller-CC filter" ++ ++parseCallerCcFilter' :: Parser CallerCcFilter ++parseCallerCcFilter' = ++ CallerCcFilter ++ <$> moduleFilter ++ <* P.char '.' ++ <*> parseNamePattern ++ where ++ moduleFilter :: Parser (Maybe ModuleName) ++ moduleFilter = ++ (Just . mkModuleName <$> moduleName) ++ <|> ++ (Nothing <$ P.char '*') ++ ++ moduleName :: Parser String ++ moduleName = do ++ c <- P.upper ++ cs <- some $ P.upper <|> P.lower <|> P.digit <|> P.oneOf "_" ++ rest <- optional $ P.try $ P.char '.' >> fmap ('.':) moduleName ++ return $ c : (cs ++ fromMaybe "" rest) ++ +diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs +index 68b9f00798..b93935816f 100644 +--- a/compiler/GHC/Hs/Binds.hs ++++ b/compiler/GHC/Hs/Binds.hs +@@ -242,7 +242,7 @@ data HsBindLR idL idR + -- type Int -> forall a'. a' -> a' + -- Notice that the coercion captures the free a'. + +- fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any ++ fun_tick :: [CoreTickish] -- ^ Ticks to put on the rhs, if any + } + + -- | Pattern Binding +@@ -262,7 +262,7 @@ data HsBindLR idL idR + pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars] + pat_lhs :: LPat idL, + pat_rhs :: GRHSs idR (LHsExpr idR), +- pat_ticks :: ([Tickish Id], [[Tickish Id]]) ++ pat_ticks :: ([CoreTickish], [[CoreTickish]]) + -- ^ Ticks to put on the rhs, if any, and ticks to put on + -- the bound variables. + } +diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs +index 09b9f6ef8a..f95fd4ff1b 100644 +--- a/compiler/GHC/Hs/Expr.hs ++++ b/compiler/GHC/Hs/Expr.hs +@@ -601,7 +601,7 @@ data HsExpr p + + | HsTick + (XTick p) +- (Tickish (IdP p)) ++ CoreTickish + (LHsExpr p) -- sub-expression + + | HsBinTick +diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs +index c2d466d7d8..0b86b26e03 100644 +--- a/compiler/GHC/StgToCmm/Expr.hs ++++ b/compiler/GHC/StgToCmm/Expr.hs +@@ -1147,7 +1147,7 @@ emitEnter fun = do + -- | Generate Cmm code for a tick. Depending on the type of Tickish, + -- this will either generate actual Cmm instrumentation code, or + -- simply pass on the annotation as a @CmmTickish@. +-cgTick :: Tickish Id -> FCode () ++cgTick :: StgTickish -> FCode () + cgTick tick + = do { dflags <- getDynFlags + ; case tick of +diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs +new file mode 100644 +index 0000000000..ebd93d3ecd +--- /dev/null ++++ b/compiler/Language/Haskell/Syntax/Binds.hs +@@ -0,0 +1,944 @@ ++{-# LANGUAGE ConstraintKinds #-} ++{-# LANGUAGE DeriveDataTypeable #-} ++{-# LANGUAGE DeriveFunctor #-} ++{-# LANGUAGE FlexibleContexts #-} ++{-# LANGUAGE FlexibleInstances #-} ++{-# LANGUAGE LambdaCase #-} ++{-# LANGUAGE ScopedTypeVariables #-} ++{-# LANGUAGE TypeApplications #-} ++{-# LANGUAGE TypeFamilies #-} ++{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] ++ -- in module Language.Haskell.Syntax.Extension ++{-# LANGUAGE ViewPatterns #-} ++ ++ ++{- ++(c) The University of Glasgow 2006 ++(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 ++ ++\section[HsBinds]{Abstract syntax: top-level bindings and signatures} ++ ++Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@. ++-} ++ ++-- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.* ++module Language.Haskell.Syntax.Binds where ++ ++import GHC.Prelude ++ ++import {-# SOURCE #-} Language.Haskell.Syntax.Expr ++ ( LHsExpr ++ , MatchGroup ++ , GRHSs ) ++import {-# SOURCE #-} Language.Haskell.Syntax.Pat ++ ( LPat ) ++ ++import Language.Haskell.Syntax.Extension ++import Language.Haskell.Syntax.Type ++import GHC.Core ++import GHC.Tc.Types.Evidence ++import GHC.Core.Type ++import GHC.Types.Basic ++import GHC.Types.SourceText ++import GHC.Types.SrcLoc as SrcLoc ++import GHC.Types.Var ++import GHC.Types.Fixity ++import GHC.Data.Bag ++import GHC.Data.BooleanFormula (LBooleanFormula) ++ ++import GHC.Utils.Outputable ++ ++import Data.Data hiding ( Fixity ) ++import Data.Void ++ ++{- ++************************************************************************ ++* * ++\subsection{Bindings: @BindGroup@} ++* * ++************************************************************************ ++ ++Global bindings (where clauses) ++-} ++ ++-- During renaming, we need bindings where the left-hand sides ++-- have been renamed but the right-hand sides have not. ++-- Other than during renaming, these will be the same. ++ ++-- | Haskell Local Bindings ++type HsLocalBinds id = HsLocalBindsLR id id ++ ++-- | Located Haskell local bindings ++type LHsLocalBinds id = XRec id (HsLocalBinds id) ++ ++-- | Haskell Local Bindings with separate Left and Right identifier types ++-- ++-- Bindings in a 'let' expression ++-- or a 'where' clause ++data HsLocalBindsLR idL idR ++ = HsValBinds ++ (XHsValBinds idL idR) ++ (HsValBindsLR idL idR) ++ -- ^ Haskell Value Bindings ++ ++ -- There should be no pattern synonyms in the HsValBindsLR ++ -- These are *local* (not top level) bindings ++ -- The parser accepts them, however, leaving the ++ -- renamer to report them ++ ++ | HsIPBinds ++ (XHsIPBinds idL idR) ++ (HsIPBinds idR) ++ -- ^ Haskell Implicit Parameter Bindings ++ ++ | EmptyLocalBinds (XEmptyLocalBinds idL idR) ++ -- ^ Empty Local Bindings ++ ++ | XHsLocalBindsLR ++ !(XXHsLocalBindsLR idL idR) ++ ++type LHsLocalBindsLR idL idR = XRec idL (HsLocalBindsLR idL idR) ++ ++ ++-- | Haskell Value Bindings ++type HsValBinds id = HsValBindsLR id id ++ ++-- | Haskell Value bindings with separate Left and Right identifier types ++-- (not implicit parameters) ++-- Used for both top level and nested bindings ++-- May contain pattern synonym bindings ++data HsValBindsLR idL idR ++ = -- | Value Bindings In ++ -- ++ -- Before renaming RHS; idR is always RdrName ++ -- Not dependency analysed ++ -- Recursive by default ++ ValBinds ++ (XValBinds idL idR) ++ (LHsBindsLR idL idR) [LSig idR] ++ ++ -- | Value Bindings Out ++ -- ++ -- After renaming RHS; idR can be Name or Id Dependency analysed, ++ -- later bindings in the list may depend on earlier ones. ++ | XValBindsLR ++ !(XXValBindsLR idL idR) ++ ++-- --------------------------------------------------------------------- ++ ++-- | Located Haskell Binding ++type LHsBind id = LHsBindLR id id ++ ++-- | Located Haskell Bindings ++type LHsBinds id = LHsBindsLR id id ++ ++-- | Haskell Binding ++type HsBind id = HsBindLR id id ++ ++-- | Located Haskell Bindings with separate Left and Right identifier types ++type LHsBindsLR idL idR = Bag (LHsBindLR idL idR) ++ ++-- | Located Haskell Binding with separate Left and Right identifier types ++type LHsBindLR idL idR = XRec idL (HsBindLR idL idR) ++ ++{- Note [FunBind vs PatBind] ++ ~~~~~~~~~~~~~~~~~~~~~~~~~ ++The distinction between FunBind and PatBind is a bit subtle. FunBind covers ++patterns which resemble function bindings and simple variable bindings. ++ ++ f x = e ++ f !x = e ++ f = e ++ !x = e -- FunRhs has SrcStrict ++ x `f` y = e -- FunRhs has Infix ++ ++The actual patterns and RHSs of a FunBind are encoding in fun_matches. ++The m_ctxt field of each Match in fun_matches will be FunRhs and carries ++two bits of information about the match, ++ ++ * The mc_fixity field on each Match describes the fixity of the ++ function binder in that match. E.g. this is legal: ++ f True False = e1 ++ True `f` True = e2 ++ ++ * The mc_strictness field is used /only/ for nullary FunBinds: ones ++ with one Match, which has no pats. For these, it describes whether ++ the match is decorated with a bang (e.g. `!x = e`). ++ ++By contrast, PatBind represents data constructor patterns, as well as a few ++other interesting cases. Namely, ++ ++ Just x = e ++ (x) = e ++ x :: Ty = e ++-} ++ ++-- | Haskell Binding with separate Left and Right id's ++data HsBindLR idL idR ++ = -- | Function-like Binding ++ -- ++ -- FunBind is used for both functions @f x = e@ ++ -- and variables @f = \x -> e@ ++ -- and strict variables @!x = x + 1@ ++ -- ++ -- Reason 1: Special case for type inference: see 'GHC.Tc.Gen.Bind.tcMonoBinds'. ++ -- ++ -- Reason 2: Instance decls can only have FunBinds, which is convenient. ++ -- If you change this, you'll need to change e.g. rnMethodBinds ++ -- ++ -- But note that the form @f :: a->a = ...@ ++ -- parses as a pattern binding, just like ++ -- @(f :: a -> a) = ... @ ++ -- ++ -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their ++ -- 'MatchContext'. See Note [FunBind vs PatBind] for ++ -- details about the relationship between FunBind and PatBind. ++ -- ++ -- 'GHC.Parser.Annotation.AnnKeywordId's ++ -- ++ -- - 'GHC.Parser.Annotation.AnnFunId', attached to each element of fun_matches ++ -- ++ -- - 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere', ++ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ FunBind { ++ ++ fun_ext :: XFunBind idL idR, ++ ++ -- ^ After the renamer (but before the type-checker), this contains the ++ -- locally-bound free variables of this defn. See Note [Bind free vars] ++ -- ++ -- After the type-checker, this contains a coercion from the type of ++ -- the MatchGroup to the type of the Id. Example: ++ -- ++ -- @ ++ -- f :: Int -> forall a. a -> a ++ -- f x y = y ++ -- @ ++ -- ++ -- Then the MatchGroup will have type (Int -> a' -> a') ++ -- (with a free type variable a'). The coercion will take ++ -- a CoreExpr of this type and convert it to a CoreExpr of ++ -- type Int -> forall a'. a' -> a' ++ -- Notice that the coercion captures the free a'. ++ ++ fun_id :: LIdP idL, -- Note [fun_id in Match] in GHC.Hs.Expr ++ ++ fun_matches :: MatchGroup idR (LHsExpr idR), -- ^ The payload ++ ++ fun_tick :: [CoreTickish] -- ^ Ticks to put on the rhs, if any ++ } ++ ++ -- | Pattern Binding ++ -- ++ -- The pattern is never a simple variable; ++ -- That case is done by FunBind. ++ -- See Note [FunBind vs PatBind] for details about the ++ -- relationship between FunBind and PatBind. ++ ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang', ++ -- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere', ++ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | PatBind { ++ pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars] ++ pat_lhs :: LPat idL, ++ pat_rhs :: GRHSs idR (LHsExpr idR), ++ pat_ticks :: ([CoreTickish], [[CoreTickish]]) ++ -- ^ Ticks to put on the rhs, if any, and ticks to put on ++ -- the bound variables. ++ } ++ ++ -- | Variable Binding ++ -- ++ -- Dictionary binding and suchlike. ++ -- All VarBinds are introduced by the type checker ++ | VarBind { ++ var_ext :: XVarBind idL idR, ++ var_id :: IdP idL, ++ var_rhs :: LHsExpr idR -- ^ Located only for consistency ++ } ++ ++ -- | Abstraction Bindings ++ | AbsBinds { -- Binds abstraction; TRANSLATION ++ abs_ext :: XAbsBinds idL idR, ++ abs_tvs :: [TyVar], ++ abs_ev_vars :: [EvVar], -- ^ Includes equality constraints ++ ++ -- | AbsBinds only gets used when idL = idR after renaming, ++ -- but these need to be idL's for the collect... code in HsUtil ++ -- to have the right type ++ abs_exports :: [ABExport idL], ++ ++ -- | Evidence bindings ++ -- Why a list? See "GHC.Tc.TyCl.Instance" ++ -- Note [Typechecking plan for instance declarations] ++ abs_ev_binds :: [TcEvBinds], ++ ++ -- | Typechecked user bindings ++ abs_binds :: LHsBinds idL, ++ ++ abs_sig :: Bool -- See Note [The abs_sig field of AbsBinds] ++ } ++ ++ -- | Patterns Synonym Binding ++ | PatSynBind ++ (XPatSynBind idL idR) ++ (PatSynBind idL idR) ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern', ++ -- 'GHC.Parser.Annotation.AnnLarrow','GHC.Parser.Annotation.AnnEqual', ++ -- 'GHC.Parser.Annotation.AnnWhere' ++ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | XHsBindsLR !(XXHsBindsLR idL idR) ++ ++ ++ -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds] ++ -- ++ -- Creates bindings for (polymorphic, overloaded) poly_f ++ -- in terms of monomorphic, non-overloaded mono_f ++ -- ++ -- Invariants: ++ -- 1. 'binds' binds mono_f ++ -- 2. ftvs is a subset of tvs ++ -- 3. ftvs includes all tyvars free in ds ++ -- ++ -- See Note [AbsBinds] ++ ++-- | Abstraction Bindings Export ++data ABExport p ++ = ABE { abe_ext :: XABE p ++ , abe_poly :: IdP p -- ^ Any INLINE pragma is attached to this Id ++ , abe_mono :: IdP p ++ , abe_wrap :: HsWrapper -- ^ See Note [ABExport wrapper] ++ -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly ++ , abe_prags :: TcSpecPrags -- ^ SPECIALISE pragmas ++ } ++ | XABExport !(XXABExport p) ++ ++ ++-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern', ++-- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnLarrow', ++-- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen' @'{'@, ++-- 'GHC.Parser.Annotation.AnnClose' @'}'@, ++ ++-- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++-- | Pattern Synonym binding ++data PatSynBind idL idR ++ = PSB { psb_ext :: XPSB idL idR, -- ^ Post renaming, FVs. ++ -- See Note [Bind free vars] ++ psb_id :: LIdP idL, -- ^ Name of the pattern synonym ++ psb_args :: HsPatSynDetails idR, -- ^ Formal parameter names ++ psb_def :: LPat idR, -- ^ Right-hand side ++ psb_dir :: HsPatSynDir idR -- ^ Directionality ++ } ++ | XPatSynBind !(XXPatSynBind idL idR) ++ ++{- ++Note [AbsBinds] ++~~~~~~~~~~~~~~~ ++The AbsBinds constructor is used in the output of the type checker, to ++record *typechecked* and *generalised* bindings. Specifically ++ ++ AbsBinds { abs_tvs = tvs ++ , abs_ev_vars = [d1,d2] ++ , abs_exports = [ABE { abe_poly = fp, abe_mono = fm ++ , abe_wrap = fwrap } ++ ABE { slly for g } ] ++ , abs_ev_binds = DBINDS ++ , abs_binds = BIND[fm,gm] } ++ ++where 'BIND' binds the monomorphic Ids 'fm' and 'gm', means ++ ++ fp = fwrap [/\ tvs. \d1 d2. letrec { DBINDS ] ++ [ ; BIND[fm,gm] } ] ++ [ in fm ] ++ ++ gp = ...same again, with gm instead of fm ++ ++The 'fwrap' is an impedance-matcher that typically does nothing; see ++Note [ABExport wrapper]. ++ ++This is a pretty bad translation, because it duplicates all the bindings. ++So the desugarer tries to do a better job: ++ ++ fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of ++ (fm,gm) -> fm ++ ..ditto for gp.. ++ ++ tp = /\ [a,b] -> \ [d1,d2] -> letrec { DBINDS; BIND } ++ in (fm,gm) ++ ++In general: ++ ++ * abs_tvs are the type variables over which the binding group is ++ generalised ++ * abs_ev_var are the evidence variables (usually dictionaries) ++ over which the binding group is generalised ++ * abs_binds are the monomorphic bindings ++ * abs_ex_binds are the evidence bindings that wrap the abs_binds ++ * abs_exports connects the monomorphic Ids bound by abs_binds ++ with the polymorphic Ids bound by the AbsBinds itself. ++ ++For example, consider a module M, with this top-level binding, where ++there is no type signature for M.reverse, ++ M.reverse [] = [] ++ M.reverse (x:xs) = M.reverse xs ++ [x] ++ ++In Hindley-Milner, a recursive binding is typechecked with the ++*recursive* uses being *monomorphic*. So after typechecking *and* ++desugaring we will get something like this ++ ++ M.reverse :: forall a. [a] -> [a] ++ = /\a. letrec ++ reverse :: [a] -> [a] = \xs -> case xs of ++ [] -> [] ++ (x:xs) -> reverse xs ++ [x] ++ in reverse ++ ++Notice that 'M.reverse' is polymorphic as expected, but there is a local ++definition for plain 'reverse' which is *monomorphic*. The type variable ++'a' scopes over the entire letrec. ++ ++That's after desugaring. What about after type checking but before ++desugaring? That's where AbsBinds comes in. It looks like this: ++ ++ AbsBinds { abs_tvs = [a] ++ , abs_ev_vars = [] ++ , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a], ++ , abe_mono = reverse :: [a] -> [a]}] ++ , abs_ev_binds = {} ++ , abs_binds = { reverse :: [a] -> [a] ++ = \xs -> case xs of ++ [] -> [] ++ (x:xs) -> reverse xs ++ [x] } } ++ ++Here, ++ ++ * abs_tvs says what type variables are abstracted over the binding ++ group, just 'a' in this case. ++ * abs_binds is the *monomorphic* bindings of the group ++ * abs_exports describes how to get the polymorphic Id 'M.reverse' ++ from the monomorphic one 'reverse' ++ ++Notice that the *original* function (the polymorphic one you thought ++you were defining) appears in the abe_poly field of the ++abs_exports. The bindings in abs_binds are for fresh, local, Ids with ++a *monomorphic* Id. ++ ++If there is a group of mutually recursive (see Note [Polymorphic ++recursion]) functions without type signatures, we get one AbsBinds ++with the monomorphic versions of the bindings in abs_binds, and one ++element of abe_exports for each variable bound in the mutually ++recursive group. This is true even for pattern bindings. Example: ++ (f,g) = (\x -> x, f) ++After type checking we get ++ AbsBinds { abs_tvs = [a] ++ , abs_exports = [ ABE { abe_poly = M.f :: forall a. a -> a ++ , abe_mono = f :: a -> a } ++ , ABE { abe_poly = M.g :: forall a. a -> a ++ , abe_mono = g :: a -> a }] ++ , abs_binds = { (f,g) = (\x -> x, f) } ++ ++Note [Polymorphic recursion] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++Consider ++ Rec { f x = ...(g ef)... ++ ++ ; g :: forall a. [a] -> [a] ++ ; g y = ...(f eg)... } ++ ++These bindings /are/ mutually recursive (f calls g, and g calls f). ++But we can use the type signature for g to break the recursion, ++like this: ++ ++ 1. Add g :: forall a. [a] -> [a] to the type environment ++ ++ 2. Typecheck the definition of f, all by itself, ++ including generalising it to find its most general ++ type, say f :: forall b. b -> b -> [b] ++ ++ 3. Extend the type environment with that type for f ++ ++ 4. Typecheck the definition of g, all by itself, ++ checking that it has the type claimed by its signature ++ ++Steps 2 and 4 each generate a separate AbsBinds, so we end ++up with ++ Rec { AbsBinds { ...for f ... } ++ ; AbsBinds { ...for g ... } } ++ ++This approach allows both f and to call each other ++polymorphically, even though only g has a signature. ++ ++We get an AbsBinds that encompasses multiple source-program ++bindings only when ++ * Each binding in the group has at least one binder that ++ lacks a user type signature ++ * The group forms a strongly connected component ++ ++ ++Note [The abs_sig field of AbsBinds] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++The abs_sig field supports a couple of special cases for bindings. ++Consider ++ ++ x :: Num a => (# a, a #) ++ x = (# 3, 4 #) ++ ++The general desugaring for AbsBinds would give ++ ++ x = /\a. \ ($dNum :: Num a) -> ++ letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in ++ xm ++ ++But that has an illegal let-binding for an unboxed tuple. In this ++case we'd prefer to generate the (more direct) ++ ++ x = /\ a. \ ($dNum :: Num a) -> ++ (# fromInteger $dNum 3, fromInteger $dNum 4 #) ++ ++A similar thing happens with representation-polymorphic defns ++(#11405): ++ ++ undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a ++ undef = error "undef" ++ ++Again, the vanilla desugaring gives a local let-binding for a ++representation-polymorphic (undefm :: a), which is illegal. But ++again we can desugar without a let: ++ ++ undef = /\ a. \ (d:HasCallStack) -> error a d "undef" ++ ++The abs_sig field supports this direct desugaring, with no local ++let-binding. When abs_sig = True ++ ++ * the abs_binds is single FunBind ++ ++ * the abs_exports is a singleton ++ ++ * we have a complete type sig for binder ++ and hence the abs_binds is non-recursive ++ (it binds the mono_id but refers to the poly_id ++ ++These properties are exploited in GHC.HsToCore.Binds.dsAbsBinds to ++generate code without a let-binding. ++ ++Note [ABExport wrapper] ++~~~~~~~~~~~~~~~~~~~~~~~ ++Consider ++ (f,g) = (\x.x, \y.y) ++This ultimately desugars to something like this: ++ tup :: forall a b. (a->a, b->b) ++ tup = /\a b. (\x:a.x, \y:b.y) ++ f :: forall a. a -> a ++ f = /\a. case tup a Any of ++ (fm::a->a,gm:Any->Any) -> fm ++ ...similarly for g... ++ ++The abe_wrap field deals with impedance-matching between ++ (/\a b. case tup a b of { (f,g) -> f }) ++and the thing we really want, which may have fewer type ++variables. The action happens in GHC.Tc.Gen.Bind.mkExport. ++ ++Note [Bind free vars] ++~~~~~~~~~~~~~~~~~~~~~ ++The bind_fvs field of FunBind and PatBind records the free variables ++of the definition. It is used for the following purposes ++ ++a) Dependency analysis prior to type checking ++ (see GHC.Tc.Gen.Bind.tc_group) ++ ++b) Deciding whether we can do generalisation of the binding ++ (see GHC.Tc.Gen.Bind.decideGeneralisationPlan) ++ ++c) Deciding whether the binding can be used in static forms ++ (see GHC.Tc.Gen.Expr.checkClosedInStaticForm for the HsStatic case and ++ GHC.Tc.Gen.Bind.isClosedBndrGroup). ++ ++Specifically, ++ ++ * bind_fvs includes all free vars that are defined in this module ++ (including top-level things and lexically scoped type variables) ++ ++ * bind_fvs excludes imported vars; this is just to keep the set smaller ++ ++ * Before renaming, and after typechecking, the field is unused; ++ it's just an error thunk ++-} ++ ++ ++{- ++************************************************************************ ++* * ++ Implicit parameter bindings ++* * ++************************************************************************ ++-} ++ ++-- | Haskell Implicit Parameter Bindings ++data HsIPBinds id ++ = IPBinds ++ (XIPBinds id) ++ [LIPBind id] ++ -- TcEvBinds -- Only in typechecker output; binds ++ -- -- uses of the implicit parameters ++ | XHsIPBinds !(XXHsIPBinds id) ++ ++ ++-- | Located Implicit Parameter Binding ++type LIPBind id = XRec id (IPBind id) ++-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a ++-- list ++ ++-- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++-- | Implicit parameter bindings. ++-- ++-- These bindings start off as (Left "x") in the parser and stay ++-- that way until after type-checking when they are replaced with ++-- (Right d), where "d" is the name of the dictionary holding the ++-- evidence for the implicit parameter. ++-- ++-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual' ++ ++-- For details on above see note [Api annotations] in GHC.Parser.Annotation ++data IPBind id ++ = IPBind ++ (XCIPBind id) ++ (Either (XRec id HsIPName) (IdP id)) ++ (LHsExpr id) ++ | XIPBind !(XXIPBind id) ++ ++{- ++************************************************************************ ++* * ++\subsection{@Sig@: type signatures and value-modifying user pragmas} ++* * ++************************************************************************ ++ ++It is convenient to lump ``value-modifying'' user-pragmas (e.g., ++``specialise this function to these four types...'') in with type ++signatures. Then all the machinery to move them into place, etc., ++serves for both. ++-} ++ ++-- | Located Signature ++type LSig pass = XRec pass (Sig pass) ++ ++-- | Signatures and pragmas ++data Sig pass ++ = -- | An ordinary type signature ++ -- ++ -- > f :: Num a => a -> a ++ -- ++ -- After renaming, this list of Names contains the named ++ -- wildcards brought into scope by this signature. For a signature ++ -- @_ -> _a -> Bool@, the renamer will leave the unnamed wildcard @_@ ++ -- untouched, and the named wildcard @_a@ is then replaced with ++ -- fresh meta vars in the type. Their names are stored in the type ++ -- signature that brought them into scope, in this third field to be ++ -- more specific. ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon', ++ -- 'GHC.Parser.Annotation.AnnComma' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ TypeSig ++ (XTypeSig pass) ++ [LIdP pass] -- LHS of the signature; e.g. f,g,h :: blah ++ (LHsSigWcType pass) -- RHS of the signature; can have wildcards ++ ++ -- | A pattern synonym type signature ++ -- ++ -- > pattern Single :: () => (Show a) => a -> [a] ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern', ++ -- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnForall' ++ -- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | PatSynSig (XPatSynSig pass) [LIdP pass] (LHsSigType pass) ++ -- P :: forall a b. Req => Prov => ty ++ ++ -- | A signature for a class method ++ -- False: ordinary class-method signature ++ -- True: generic-default class method signature ++ -- e.g. class C a where ++ -- op :: a -> a -- Ordinary ++ -- default op :: Eq a => a -> a -- Generic default ++ -- No wildcards allowed here ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDefault', ++ -- 'GHC.Parser.Annotation.AnnDcolon' ++ | ClassOpSig (XClassOpSig pass) Bool [LIdP pass] (LHsSigType pass) ++ ++ -- | A type signature in generated code, notably the code ++ -- generated for record selectors. We simply record ++ -- the desired Id itself, replete with its name, type ++ -- and IdDetails. Otherwise it's just like a type ++ -- signature: there should be an accompanying binding ++ | IdSig (XIdSig pass) Id ++ ++ -- | An ordinary fixity declaration ++ -- ++ -- > infixl 8 *** ++ -- ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnInfix', ++ -- 'GHC.Parser.Annotation.AnnVal' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | FixSig (XFixSig pass) (FixitySig pass) ++ ++ -- | An inline pragma ++ -- ++ -- > {#- INLINE f #-} ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : ++ -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# INLINE'@ and @'['@, ++ -- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnTilde', ++ -- 'GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | InlineSig (XInlineSig pass) ++ (LIdP pass) -- Function name ++ InlinePragma -- Never defaultInlinePragma ++ ++ -- | A specialisation pragma ++ -- ++ -- > {-# SPECIALISE f :: Int -> Int #-} ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@, ++ -- 'GHC.Parser.Annotation.AnnTilde', ++ -- 'GHC.Parser.Annotation.AnnVal', ++ -- 'GHC.Parser.Annotation.AnnClose' @']'@ and @'\#-}'@, ++ -- 'GHC.Parser.Annotation.AnnDcolon' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | SpecSig (XSpecSig pass) ++ (LIdP pass) -- Specialise a function or datatype ... ++ [LHsSigType pass] -- ... to these types ++ InlinePragma -- The pragma on SPECIALISE_INLINE form. ++ -- If it's just defaultInlinePragma, then we said ++ -- SPECIALISE, not SPECIALISE_INLINE ++ ++ -- | A specialisation pragma for instance declarations only ++ -- ++ -- > {-# SPECIALISE instance Eq [Int] #-} ++ -- ++ -- (Class tys); should be a specialisation of the ++ -- current instance declaration ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnInstance','GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass) ++ -- Note [Pragma source text] in GHC.Types.SourceText ++ ++ -- | A minimal complete definition pragma ++ -- ++ -- > {-# MINIMAL a | (b, c | (d | e)) #-} ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnVbar','GHC.Parser.Annotation.AnnComma', ++ -- 'GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | MinimalSig (XMinimalSig pass) ++ SourceText (LBooleanFormula (LIdP pass)) ++ -- Note [Pragma source text] in GHC.Types.SourceText ++ ++ -- | A "set cost centre" pragma for declarations ++ -- ++ -- > {-# SCC funName #-} ++ -- ++ -- or ++ -- ++ -- > {-# SCC funName "cost_centre_name" #-} ++ ++ | SCCFunSig (XSCCFunSig pass) ++ SourceText -- Note [Pragma source text] in GHC.Types.SourceText ++ (LIdP pass) -- Function name ++ (Maybe (XRec pass StringLiteral)) ++ -- | A complete match pragma ++ -- ++ -- > {-# COMPLETE C, D [:: T] #-} ++ -- ++ -- Used to inform the pattern match checker about additional ++ -- complete matchings which, for example, arise from pattern ++ -- synonym definitions. ++ | CompleteMatchSig (XCompleteMatchSig pass) ++ SourceText ++ (XRec pass [LIdP pass]) ++ (Maybe (LIdP pass)) ++ | XSig !(XXSig pass) ++ ++-- | Located Fixity Signature ++type LFixitySig pass = XRec pass (FixitySig pass) ++ ++-- | Fixity Signature ++data FixitySig pass = FixitySig (XFixitySig pass) [LIdP pass] Fixity ++ | XFixitySig !(XXFixitySig pass) ++ ++-- | Type checker Specialisation Pragmas ++-- ++-- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer ++data TcSpecPrags ++ = IsDefaultMethod -- ^ Super-specialised: a default method should ++ -- be macro-expanded at every call site ++ | SpecPrags [LTcSpecPrag] ++ deriving Data ++ ++-- | Located Type checker Specification Pragmas ++type LTcSpecPrag = Located TcSpecPrag ++ ++-- | Type checker Specification Pragma ++data TcSpecPrag ++ = SpecPrag ++ Id ++ HsWrapper ++ InlinePragma ++ -- ^ The Id to be specialised, a wrapper that specialises the ++ -- polymorphic function, and inlining spec for the specialised function ++ deriving Data ++ ++noSpecPrags :: TcSpecPrags ++noSpecPrags = SpecPrags [] ++ ++hasSpecPrags :: TcSpecPrags -> Bool ++hasSpecPrags (SpecPrags ps) = not (null ps) ++hasSpecPrags IsDefaultMethod = False ++ ++isDefaultMethod :: TcSpecPrags -> Bool ++isDefaultMethod IsDefaultMethod = True ++isDefaultMethod (SpecPrags {}) = False ++ ++isFixityLSig :: forall p. UnXRec p => LSig p -> Bool ++isFixityLSig (unXRec @p -> FixSig {}) = True ++isFixityLSig _ = False ++ ++isTypeLSig :: forall p. UnXRec p => LSig p -> Bool -- Type signatures ++isTypeLSig (unXRec @p -> TypeSig {}) = True ++isTypeLSig (unXRec @p -> ClassOpSig {}) = True ++isTypeLSig (unXRec @p -> IdSig {}) = True ++isTypeLSig _ = False ++ ++isSpecLSig :: forall p. UnXRec p => LSig p -> Bool ++isSpecLSig (unXRec @p -> SpecSig {}) = True ++isSpecLSig _ = False ++ ++isSpecInstLSig :: forall p. UnXRec p => LSig p -> Bool ++isSpecInstLSig (unXRec @p -> SpecInstSig {}) = True ++isSpecInstLSig _ = False ++ ++isPragLSig :: forall p. UnXRec p => LSig p -> Bool ++-- Identifies pragmas ++isPragLSig (unXRec @p -> SpecSig {}) = True ++isPragLSig (unXRec @p -> InlineSig {}) = True ++isPragLSig (unXRec @p -> SCCFunSig {}) = True ++isPragLSig (unXRec @p -> CompleteMatchSig {}) = True ++isPragLSig _ = False ++ ++isInlineLSig :: forall p. UnXRec p => LSig p -> Bool ++-- Identifies inline pragmas ++isInlineLSig (unXRec @p -> InlineSig {}) = True ++isInlineLSig _ = False ++ ++isMinimalLSig :: forall p. UnXRec p => LSig p -> Bool ++isMinimalLSig (unXRec @p -> MinimalSig {}) = True ++isMinimalLSig _ = False ++ ++isSCCFunSig :: forall p. UnXRec p => LSig p -> Bool ++isSCCFunSig (unXRec @p -> SCCFunSig {}) = True ++isSCCFunSig _ = False ++ ++isCompleteMatchSig :: forall p. UnXRec p => LSig p -> Bool ++isCompleteMatchSig (unXRec @p -> CompleteMatchSig {} ) = True ++isCompleteMatchSig _ = False ++ ++hsSigDoc :: Sig name -> SDoc ++hsSigDoc (TypeSig {}) = text "type signature" ++hsSigDoc (PatSynSig {}) = text "pattern synonym signature" ++hsSigDoc (ClassOpSig _ is_deflt _ _) ++ | is_deflt = text "default type signature" ++ | otherwise = text "class method signature" ++hsSigDoc (IdSig {}) = text "id signature" ++hsSigDoc (SpecSig _ _ _ inl) ++ = ppr inl <+> text "pragma" ++hsSigDoc (InlineSig _ _ prag) = ppr (inlinePragmaSpec prag) <+> text "pragma" ++hsSigDoc (SpecInstSig _ src _) ++ = pprWithSourceText src empty <+> text "instance pragma" ++hsSigDoc (FixSig {}) = text "fixity declaration" ++hsSigDoc (MinimalSig {}) = text "MINIMAL pragma" ++hsSigDoc (SCCFunSig {}) = text "SCC pragma" ++hsSigDoc (CompleteMatchSig {}) = text "COMPLETE pragma" ++hsSigDoc (XSig {}) = text "XSIG TTG extension" ++ ++{- ++************************************************************************ ++* * ++\subsection[PatSynBind]{A pattern synonym definition} ++* * ++************************************************************************ ++-} ++ ++-- | Haskell Pattern Synonym Details ++type HsPatSynDetails pass = HsConDetails Void (LIdP pass) [RecordPatSynField pass] ++ ++-- See Note [Record PatSyn Fields] ++-- | Record Pattern Synonym Field ++data RecordPatSynField pass ++ = RecordPatSynField ++ { recordPatSynField :: FieldOcc pass ++ -- ^ Field label visible in rest of the file ++ , recordPatSynPatVar :: LIdP pass ++ -- ^ Filled in by renamer, the name used internally by the pattern ++ } ++ ++ ++{- ++Note [Record PatSyn Fields] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++ ++Consider the following two pattern synonyms. ++ ++ pattern P x y = ([x,True], [y,'v']) ++ pattern Q{ x, y } =([x,True], [y,'v']) ++ ++In P, we just have two local binders, x and y. ++ ++In Q, we have local binders but also top-level record selectors ++ x :: ([Bool], [Char]) -> Bool ++ y :: ([Bool], [Char]) -> Char ++ ++Both are recorded in the `RecordPatSynField`s for `x` and `y`: ++* recordPatSynField: the top-level record selector ++* recordPatSynPatVar: the local `x`, bound only in the RHS of the pattern synonym. ++ ++It would make sense to support record-like syntax ++ ++ pattern Q{ x=x1, y=y1 } = ([x1,True], [y1,'v']) ++ ++when we have a different name for the local and top-level binder, ++making the distinction between the two names clear. ++ ++-} ++instance Outputable (RecordPatSynField a) where ++ ppr (RecordPatSynField { recordPatSynField = v }) = ppr v ++ ++ ++-- | Haskell Pattern Synonym Direction ++data HsPatSynDir id ++ = Unidirectional ++ | ImplicitBidirectional ++ | ExplicitBidirectional (MatchGroup id (LHsExpr id)) +diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs +new file mode 100644 +index 0000000000..478ac1e2ac +--- /dev/null ++++ b/compiler/Language/Haskell/Syntax/Expr.hs +@@ -0,0 +1,1775 @@ ++{-# LANGUAGE CPP #-} ++{-# LANGUAGE ConstraintKinds #-} ++{-# LANGUAGE DataKinds #-} ++{-# LANGUAGE DeriveDataTypeable #-} ++{-# LANGUAGE ExistentialQuantification #-} ++{-# LANGUAGE FlexibleContexts #-} ++{-# LANGUAGE FlexibleInstances #-} ++{-# LANGUAGE LambdaCase #-} ++{-# LANGUAGE ScopedTypeVariables #-} ++{-# LANGUAGE StandaloneDeriving #-} ++{-# LANGUAGE TypeApplications #-} ++{-# LANGUAGE TypeFamilyDependencies #-} ++{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] ++ -- in module Language.Haskell.Syntax.Extension ++ ++{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} ++ ++{- ++(c) The University of Glasgow 2006 ++(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 ++-} ++ ++-- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.* ++ ++-- | Abstract Haskell syntax for expressions. ++module Language.Haskell.Syntax.Expr where ++ ++#include "HsVersions.h" ++ ++-- friends: ++import GHC.Prelude ++ ++import Language.Haskell.Syntax.Decls ++import Language.Haskell.Syntax.Pat ++import Language.Haskell.Syntax.Lit ++import Language.Haskell.Syntax.Extension ++import Language.Haskell.Syntax.Type ++import Language.Haskell.Syntax.Binds ++ ++-- others: ++import GHC.Tc.Types.Evidence ++import GHC.Core ++import GHC.Types.Name ++import GHC.Types.Basic ++import GHC.Types.Fixity ++import GHC.Types.SourceText ++import GHC.Types.SrcLoc ++import GHC.Core.ConLike ++import GHC.Unit.Module (ModuleName) ++import GHC.Utils.Outputable ++import GHC.Utils.Panic ++import GHC.Data.FastString ++import GHC.Core.Type ++ ++-- libraries: ++import Data.Data hiding (Fixity(..)) ++import qualified Data.Data as Data (Fixity(..)) ++ ++import GHCi.RemoteTypes ( ForeignRef ) ++import qualified Language.Haskell.TH as TH (Q) ++ ++{- ++************************************************************************ ++* * ++\subsection{Expressions proper} ++* * ++************************************************************************ ++-} ++ ++-- * Expressions proper ++ ++-- | Located Haskell Expression ++type LHsExpr p = XRec p (HsExpr p) ++ -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when ++ -- in a list ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++------------------------- ++{- Note [NoSyntaxExpr] ++~~~~~~~~~~~~~~~~~~~~~~ ++Syntax expressions can be missing (NoSyntaxExprRn or NoSyntaxExprTc) ++for several reasons: ++ ++ 1. As described in Note [Rebindable if] ++ ++ 2. In order to suppress "not in scope: xyz" messages when a bit of ++ rebindable syntax does not apply. For example, when using an irrefutable ++ pattern in a BindStmt, we don't need a `fail` operator. ++ ++ 3. Rebindable syntax might just not make sense. For example, a BodyStmt ++ contains the syntax for `guard`, but that's used only in monad comprehensions. ++ If we had more of a whiz-bang type system, we might be able to rule this ++ case out statically. ++-} ++ ++-- | Syntax Expression ++-- ++-- SyntaxExpr is represents the function used in interpreting rebindable ++-- syntax. In the parser, we have no information to supply; in the renamer, ++-- we have the name of the function (but see ++-- Note [Monad fail : Rebindable syntax, overloaded strings] for a wrinkle) ++-- and in the type-checker we have a more elaborate structure 'SyntaxExprTc'. ++-- ++-- In some contexts, rebindable syntax is not implemented, and so we have ++-- constructors to represent that possibility in both the renamer and ++-- typechecker instantiations. ++-- ++-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for ++-- @(>>=)@, and then instantiated by the type checker with its type args ++-- etc ++type family SyntaxExpr p ++ ++-- | Command Syntax Table (for Arrow syntax) ++type CmdSyntaxTable p = [(Name, HsExpr p)] ++-- See Note [CmdSyntaxTable] ++ ++{- ++Note [CmdSyntaxTable] ++~~~~~~~~~~~~~~~~~~~~~ ++Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps ++track of the methods needed for a Cmd. ++ ++* Before the renamer, this list is an empty list ++ ++* After the renamer, it takes the form @[(std_name, HsVar actual_name)]@ ++ For example, for the 'arr' method ++ * normal case: (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr) ++ * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22) ++ where @arr_22@ is whatever 'arr' is in scope ++ ++* After the type checker, it takes the form [(std_name, )] ++ where is the evidence for the method. This evidence is ++ instantiated with the class, but is still polymorphic in everything ++ else. For example, in the case of 'arr', the evidence has type ++ forall b c. (b->c) -> a b c ++ where 'a' is the ambient type of the arrow. This polymorphism is ++ important because the desugarer uses the same evidence at multiple ++ different types. ++ ++This is Less Cool than what we normally do for rebindable syntax, which is to ++make fully-instantiated piece of evidence at every use site. The Cmd way ++is Less Cool because ++ * The renamer has to predict which methods are needed. ++ See the tedious GHC.Rename.Expr.methodNamesCmd. ++ ++ * The desugarer has to know the polymorphic type of the instantiated ++ method. This is checked by Inst.tcSyntaxName, but is less flexible ++ than the rest of rebindable syntax, where the type is less ++ pre-ordained. (And this flexibility is useful; for example we can ++ typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.) ++-} ++ ++-- | A Haskell expression. ++data HsExpr p ++ = HsVar (XVar p) ++ (LIdP p) -- ^ Variable ++ -- See Note [Located RdrNames] ++ ++ | HsUnboundVar (XUnboundVar p) ++ OccName -- ^ Unbound variable; also used for "holes" ++ -- (_ or _x). ++ -- Turned from HsVar to HsUnboundVar by the ++ -- renamer, when it finds an out-of-scope ++ -- variable or hole. ++ -- The (XUnboundVar p) field becomes an HoleExprRef ++ -- after typechecking; this is where the ++ -- erroring expression will be written after ++ -- solving. See Note [Holes] in GHC.Tc.Types.Constraint. ++ ++ | HsConLikeOut (XConLikeOut p) ++ ConLike -- ^ After typechecker only; must be different ++ -- HsVar for pretty printing ++ ++ | HsRecFld (XRecFld p) ++ (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector ++ -- The parser produces HsVars ++ -- The renamer renames record-field selectors to HsRecFld ++ -- The typechecker preserves HsRecFld ++ ++ | HsOverLabel (XOverLabel p) ++ (Maybe (IdP p)) FastString ++ -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels) ++ -- @Just id@ means @RebindableSyntax@ is in use, and gives the id of the ++ -- in-scope 'fromLabel'. ++ -- NB: Not in use after typechecking ++ ++ | HsIPVar (XIPVar p) ++ HsIPName -- ^ Implicit parameter (not in use after typechecking) ++ | HsOverLit (XOverLitE p) ++ (HsOverLit p) -- ^ Overloaded literals ++ ++ | HsLit (XLitE p) ++ (HsLit p) -- ^ Simple (non-overloaded) literals ++ ++ | HsLam (XLam p) ++ (MatchGroup p (LHsExpr p)) ++ -- ^ Lambda abstraction. Currently always a single match ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam', ++ -- 'GHC.Parser.Annotation.AnnRarrow', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam', ++ -- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsApp (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application ++ ++ | HsAppType (XAppTypeE p) -- After typechecking: the type argument ++ (LHsExpr p) ++ (LHsWcType (NoGhcTc p)) -- ^ Visible type application ++ -- ++ -- Explicit type argument; e.g f @Int x y ++ -- NB: Has wildcards, but no implicit quantification ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt', ++ ++ -- | Operator applications: ++ -- NB Bracketed ops such as (+) come out as Vars. ++ ++ -- NB We need an expr for the operator in an OpApp/Section since ++ -- the typechecker may need to apply the operator to a few types. ++ ++ | OpApp (XOpApp p) ++ (LHsExpr p) -- left operand ++ (LHsExpr p) -- operator ++ (LHsExpr p) -- right operand ++ ++ -- | Negation operator. Contains the negated expression and the name ++ -- of 'negate' ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnMinus' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | NegApp (XNegApp p) ++ (LHsExpr p) ++ (SyntaxExpr p) ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@, ++ -- 'GHC.Parser.Annotation.AnnClose' @')'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsPar (XPar p) ++ (LHsExpr p) -- ^ Parenthesised expr; see Note [Parens in HsSyn] ++ ++ | SectionL (XSectionL p) ++ (LHsExpr p) -- operand; see Note [Sections in HsSyn] ++ (LHsExpr p) -- operator ++ | SectionR (XSectionR p) ++ (LHsExpr p) -- operator; see Note [Sections in HsSyn] ++ (LHsExpr p) -- operand ++ ++ -- | Used for explicit tuples and sections thereof ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ -- Note [ExplicitTuple] ++ | ExplicitTuple ++ (XExplicitTuple p) ++ [LHsTupArg p] ++ Boxity ++ ++ -- | Used for unboxed sum types ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(#'@, ++ -- 'GHC.Parser.Annotation.AnnVbar', 'GHC.Parser.Annotation.AnnClose' @'#)'@, ++ -- ++ -- There will be multiple 'GHC.Parser.Annotation.AnnVbar', (1 - alternative) before ++ -- the expression, (arity - alternative) after it ++ | ExplicitSum ++ (XExplicitSum p) ++ ConTag -- Alternative (one-based) ++ Arity -- Sum arity ++ (LHsExpr p) ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase', ++ -- 'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@, ++ -- 'GHC.Parser.Annotation.AnnClose' @'}'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsCase (XCase p) ++ (LHsExpr p) ++ (MatchGroup p (LHsExpr p)) ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf', ++ -- 'GHC.Parser.Annotation.AnnSemi', ++ -- 'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi', ++ -- 'GHC.Parser.Annotation.AnnElse', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsIf (XIf p) -- GhcPs: this is a Bool; False <=> do not use ++ -- rebindable syntax ++ (LHsExpr p) -- predicate ++ (LHsExpr p) -- then part ++ (LHsExpr p) -- else part ++ ++ -- | Multi-way if ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf' ++ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsMultiIf (XMultiIf p) [LGRHS p (LHsExpr p)] ++ ++ -- | let(rec) ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet', ++ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@, ++ -- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsLet (XLet p) ++ (LHsLocalBinds p) ++ (LHsExpr p) ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo', ++ -- 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnSemi', ++ -- 'GHC.Parser.Annotation.AnnVbar', ++ -- 'GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsDo (XDo p) -- Type of the whole expression ++ (HsStmtContext (HsDoRn p)) ++ -- The parameterisation of the above is unimportant ++ -- because in this context we never use ++ -- the PatGuard or ParStmt variant ++ (XRec p [ExprLStmt p]) -- "do":one or more stmts ++ ++ -- | Syntactic list: [a,b,c,...] ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@, ++ -- 'GHC.Parser.Annotation.AnnClose' @']'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ -- See Note [Empty lists] ++ | ExplicitList ++ (XExplicitList p) -- Gives type of components of list ++ (Maybe (SyntaxExpr p)) ++ -- For OverloadedLists, the fromListN witness ++ [LHsExpr p] ++ ++ -- | Record construction ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@, ++ -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | RecordCon ++ { rcon_ext :: XRecordCon p ++ , rcon_con :: XRec p (ConLikeP p) -- The constructor ++ , rcon_flds :: HsRecordBinds p } -- The fields ++ ++ -- | Record update ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@, ++ -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | RecordUpd ++ { rupd_ext :: XRecordUpd p ++ , rupd_expr :: LHsExpr p ++ , rupd_flds :: [LHsRecUpdField p] ++ } ++ -- For a type family, the arg types are of the *instance* tycon, ++ -- not the family tycon ++ ++ -- | Expression with an explicit type signature. @e :: type@ ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | ExprWithTySig ++ (XExprWithTySig p) ++ ++ (LHsExpr p) ++ (LHsSigWcType (NoGhcTc p)) ++ ++ -- | Arithmetic sequence ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@, ++ -- 'GHC.Parser.Annotation.AnnComma','GHC.Parser.Annotation.AnnDotdot', ++ -- 'GHC.Parser.Annotation.AnnClose' @']'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | ArithSeq ++ (XArithSeq p) ++ (Maybe (SyntaxExpr p)) ++ -- For OverloadedLists, the fromList witness ++ (ArithSeqInfo p) ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ ----------------------------------------------------------- ++ -- MetaHaskell Extensions ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnOpenE','GHC.Parser.Annotation.AnnOpenEQ', ++ -- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnCloseQ' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsBracket (XBracket p) (HsBracket p) ++ ++ -- See Note [Pending Splices] ++ | HsRnBracketOut ++ (XRnBracketOut p) ++ (HsBracket (HsBracketRn p)) -- Output of the renamer is the *original* renamed ++ -- expression, plus ++ [PendingRnSplice' p] -- _renamed_ splices to be type checked ++ ++ | HsTcBracketOut ++ (XTcBracketOut p) ++ (Maybe QuoteWrapper) -- The wrapper to apply type and dictionary argument ++ -- to the quote. ++ (HsBracket (HsBracketRn p)) -- Output of the type checker is the *original* ++ -- renamed expression, plus ++ [PendingTcSplice' p] -- _typechecked_ splices to be ++ -- pasted back in by the desugarer ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsSpliceE (XSpliceE p) (HsSplice p) ++ ++ ----------------------------------------------------------- ++ -- Arrow notation extension ++ ++ -- | @proc@ notation for Arrows ++ -- ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnProc', ++ -- 'GHC.Parser.Annotation.AnnRarrow' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsProc (XProc p) ++ (LPat p) -- arrow abstraction, proc ++ (LHsCmdTop p) -- body of the abstraction ++ -- always has an empty stack ++ ++ --------------------------------------- ++ -- static pointers extension ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnStatic', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsStatic (XStatic p) -- Free variables of the body ++ (LHsExpr p) -- Body ++ ++ --------------------------------------- ++ -- Haskell program coverage (Hpc) Support ++ ++ | HsTick ++ (XTick p) ++ CoreTickish ++ (LHsExpr p) -- sub-expression ++ ++ | HsBinTick ++ (XBinTick p) ++ Int -- module-local tick number for True ++ Int -- module-local tick number for False ++ (LHsExpr p) -- sub-expression ++ ++ --------------------------------------- ++ -- Expressions annotated with pragmas, written as {-# ... #-} ++ | HsPragE (XPragE p) (HsPragE p) (LHsExpr p) ++ ++ | XExpr !(XXExpr p) ++ -- Note [Trees that Grow] extension constructor for the ++ -- general idea, and Note [Rebindable syntax and HsExpansion] ++ -- for an example of how we use it. ++ ++-- | The AST used to hard-refer to GhcPass, which was a layer violation. For now, ++-- we paper it over with this new extension point. ++type family HsDoRn p ++type family HsBracketRn p ++type family PendingRnSplice' p ++type family PendingTcSplice' p ++ ++-- --------------------------------------------------------------------- ++ ++{- ++Note [Rebindable syntax and HsExpansion] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++ ++We implement rebindable syntax (RS) support by performing a desugaring ++in the renamer. We transform GhcPs expressions affected by RS into the ++appropriate desugared form, but **annotated with the original expression**. ++ ++Let us consider a piece of code like: ++ ++ {-# LANGUAGE RebindableSyntax #-} ++ ifThenElse :: Char -> () -> () -> () ++ ifThenElse _ _ _ = () ++ x = if 'a' then () else True ++ ++The parsed AST for the RHS of x would look something like (slightly simplified): ++ ++ L locif (HsIf (L loca 'a') (L loctrue ()) (L locfalse True)) ++ ++Upon seeing such an AST with RS on, we could transform it into a ++mere function call, as per the RS rules, equivalent to the ++following function application: ++ ++ ifThenElse 'a' () True ++ ++which doesn't typecheck. But GHC would report an error about ++not being able to match the third argument's type (Bool) with the ++expected type: (), in the expression _as desugared_, i.e in ++the aforementioned function application. But the user never ++wrote a function application! This would be pretty bad. ++ ++To remedy this, instead of transforming the original HsIf ++node into mere applications of 'ifThenElse', we keep the ++original 'if' expression around too, using the TTG ++XExpr extension point to allow GHC to construct an ++'HsExpansion' value that will keep track of the original ++expression in its first field, and the desugared one in the ++second field. The resulting renamed AST would look like: ++ ++ L locif (XExpr ++ (HsExpanded ++ (HsIf (L loca 'a') ++ (L loctrue ()) ++ (L locfalse True) ++ ) ++ (App (L generatedSrcSpan ++ (App (L generatedSrcSpan ++ (App (L generatedSrcSpan (Var ifThenElse)) ++ (L loca 'a') ++ ) ++ ) ++ (L loctrue ()) ++ ) ++ ) ++ (L locfalse True) ++ ) ++ ) ++ ) ++ ++When comes the time to typecheck the program, we end up calling ++tcMonoExpr on the AST above. If this expression gives rise to ++a type error, then it will appear in a context line and GHC ++will pretty-print it using the 'Outputable (HsExpansion a b)' ++instance defined below, which *only prints the original ++expression*. This is the gist of the idea, but is not quite ++enough to recover the error messages that we had with the ++SyntaxExpr-based, typechecking/desugaring-to-core time ++implementation of rebindable syntax. The key idea is to decorate ++some elements of the desugared expression so as to be able to ++give them a special treatment when typechecking the desugared ++expression, to print a different context line or skip one ++altogether. ++ ++Whenever we 'setSrcSpan' a 'generatedSrcSpan', we update a field in ++TcLclEnv called 'tcl_in_gen_code', setting it to True, which indicates that we ++entered generated code, i.e code fabricated by the compiler when rebinding some ++syntax. If someone tries to push some error context line while that field is set ++to True, the pushing won't actually happen and the context line is just dropped. ++Once we 'setSrcSpan' a real span (for an expression that was in the original ++source code), we set 'tcl_in_gen_code' back to False, indicating that we ++"emerged from the generated code tunnel", and that the expressions we will be ++processing are relevant to report in context lines again. ++ ++You might wonder why we store a RealSrcSpan in addition to a Bool in ++the TcLclEnv: could we not store a Maybe RealSrcSpan? The problem is ++that we still generate constraints when processing generated code, ++and a CtLoc must contain a RealSrcSpan -- otherwise, error messages ++might appear without source locations. So we keep the RealSrcSpan of ++the last location spotted that wasn't generated; it's as good as ++we're going to get in generated code. Once we get to sub-trees that ++are not generated, then we update the RealSrcSpan appropriately, and ++set the tcl_in_gen_code Bool to False. ++ ++--- ++ ++A general recipe to follow this approach for new constructs could go as follows: ++ ++- Remove any GhcRn-time SyntaxExpr extensions to the relevant constructor for your ++ construct, in HsExpr or related syntax data types. ++- At renaming-time: ++ - take your original node of interest (HsIf above) ++ - rename its subexpressions (condition, true branch, false branch above) ++ - construct the suitable "rebound"-and-renamed result (ifThenElse call ++ above), where the 'SrcSpan' attached to any _fabricated node_ (the ++ HsVar/HsApp nodes, above) is set to 'generatedSrcSpan' ++ - take both the original node and that rebound-and-renamed result and wrap ++ them in an XExpr: XExpr (HsExpanded ) ++ - At typechecking-time: ++ - remove any logic that was previously dealing with your rebindable ++ construct, typically involving [tc]SyntaxOp, SyntaxExpr and friends. ++ - the XExpr (HsExpanded ... ...) case in tcExpr already makes sure that we ++ typecheck the desugared expression while reporting the original one in ++ errors ++ ++-} ++ ++-- See Note [Rebindable syntax and HsExpansion] just above. ++data HsExpansion a b ++ = HsExpanded a b ++ deriving Data ++ ++-- | Build a "wrapped" 'HsExpansion' out of an extension constructor, ++-- and the two components of the expansion: original and desugared ++-- expressions. ++-- ++-- See Note [Rebindable Syntax and HsExpansion] above for more details. ++mkExpanded ++ :: (HsExpansion a b -> b) -- ^ XExpr, XCmd, ... ++ -> a -- ^ source expression ('GhcPs') ++ -> b -- ^ "desugared" expression ++ -- ('GhcRn') ++ -> b -- ^ suitably wrapped ++ -- 'HsExpansion' ++mkExpanded xwrap a b = xwrap (HsExpanded a b) ++ ++-- | Just print the original expression (the @a@). ++instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ++ ppr (HsExpanded a b) = ifPprDebug (vcat [ppr a, ppr b]) (ppr a) ++ ++-- --------------------------------------------------------------------- ++ ++-- | A pragma, written as {-# ... #-}, that may appear within an expression. ++data HsPragE p ++ = HsPragSCC (XSCC p) ++ SourceText -- Note [Pragma source text] in GHC.Types.SourceText ++ StringLiteral -- "set cost centre" SCC pragma ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', ++ -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# GENERATED'@, ++ -- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnVal', ++ -- 'GHC.Parser.Annotation.AnnColon','GHC.Parser.Annotation.AnnVal', ++ -- 'GHC.Parser.Annotation.AnnMinus', ++ -- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnColon', ++ -- 'GHC.Parser.Annotation.AnnVal', ++ -- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@ ++ ++ | XHsPragE !(XXPragE p) ++ ++-- | Located Haskell Tuple Argument ++-- ++-- 'HsTupArg' is used for tuple sections ++-- @(,a,)@ is represented by ++-- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@ ++-- Which in turn stands for @(\x:ty1 \y:ty2. (x,a,y))@ ++type LHsTupArg id = XRec id (HsTupArg id) ++-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' ++ ++-- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++-- | Haskell Tuple Argument ++data HsTupArg id ++ = Present (XPresent id) (LHsExpr id) -- ^ The argument ++ | Missing (XMissing id) -- ^ The argument is missing, but this is its type ++ | XTupArg !(XXTupArg id) -- ^ Note [Trees that Grow] extension point ++ ++{- ++Note [Parens in HsSyn] ++~~~~~~~~~~~~~~~~~~~~~~ ++HsPar (and ParPat in patterns, HsParTy in types) is used as follows ++ ++ * HsPar is required; the pretty printer does not add parens. ++ ++ * HsPars are respected when rearranging operator fixities. ++ So a * (b + c) means what it says (where the parens are an HsPar) ++ ++ * For ParPat and HsParTy the pretty printer does add parens but this should be ++ a no-op for ParsedSource, based on the pretty printer round trip feature ++ introduced in ++ https://phabricator.haskell.org/rGHC499e43824bda967546ebf95ee33ec1f84a114a7c ++ ++ * ParPat and HsParTy are pretty printed as '( .. )' regardless of whether or ++ not they are strictly necessary. This should be addressed when #13238 is ++ completed, to be treated the same as HsPar. ++ ++ ++Note [Sections in HsSyn] ++~~~~~~~~~~~~~~~~~~~~~~~~ ++Sections should always appear wrapped in an HsPar, thus ++ HsPar (SectionR ...) ++The parser parses sections in a wider variety of situations ++(See Note [Parsing sections]), but the renamer checks for those ++parens. This invariant makes pretty-printing easier; we don't need ++a special case for adding the parens round sections. ++ ++Note [Rebindable if] ++~~~~~~~~~~~~~~~~~~~~ ++The rebindable syntax for 'if' is a bit special, because when ++rebindable syntax is *off* we do not want to treat ++ (if c then t else e) ++as if it was an application (ifThenElse c t e). Why not? ++Because we allow an 'if' to return *unboxed* results, thus ++ if blah then 3# else 4# ++whereas that would not be possible using a all to a polymorphic function ++(because you can't call a polymorphic function at an unboxed type). ++ ++So we use NoSyntaxExpr to mean "use the old built-in typing rule". ++ ++A further complication is that, in the `deriving` code, we never want ++to use rebindable syntax. So, even in GhcPs, we want to denote whether ++to use rebindable syntax or not. This is done via the type instance ++for XIf GhcPs. ++ ++Note [Record Update HsWrapper] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++There is a wrapper in RecordUpd which is used for the *required* ++constraints for pattern synonyms. This wrapper is created in the ++typechecking and is then directly used in the desugaring without ++modification. ++ ++For example, if we have the record pattern synonym P, ++ pattern P :: (Show a) => a -> Maybe a ++ pattern P{x} = Just x ++ ++ foo = (Just True) { x = False } ++then `foo` desugars to something like ++ foo = case Just True of ++ P x -> P False ++hence we need to provide the correct dictionaries to P's matcher on ++the RHS so that we can build the expression. ++ ++Note [Located RdrNames] ++~~~~~~~~~~~~~~~~~~~~~~~ ++A number of syntax elements have seemingly redundant locations attached to them. ++This is deliberate, to allow transformations making use of the API Annotations ++to easily correlate a Located Name in the RenamedSource with a Located RdrName ++in the ParsedSource. ++ ++There are unfortunately enough differences between the ParsedSource and the ++RenamedSource that the API Annotations cannot be used directly with ++RenamedSource, so this allows a simple mapping to be used based on the location. ++ ++Note [ExplicitTuple] ++~~~~~~~~~~~~~~~~~~~~ ++An ExplicitTuple is never just a data constructor like (,,,). ++That is, the `[LHsTupArg p]` argument of `ExplicitTuple` has at least ++one `Present` member (and is thus never empty). ++ ++A tuple data constructor like () or (,,,) is parsed as an `HsVar`, not an ++`ExplicitTuple`, and stays that way. This is important for two reasons: ++ ++ 1. We don't need -XTupleSections for (,,,) ++ 2. The type variables in (,,,) can be instantiated with visible type application. ++ That is, ++ ++ (,,) :: forall a b c. a -> b -> c -> (a,b,c) ++ (True,,) :: forall {b} {c}. b -> c -> (Bool,b,c) ++ ++ Note that the tuple section has *inferred* arguments, while the data ++ constructor has *specified* ones. ++ (See Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl ++ for background.) ++ ++Sadly, the grammar for this is actually ambiguous, and it's only thanks to the ++preference of a shift in a shift/reduce conflict that the parser works as this ++Note details. Search for a reference to this Note in GHC.Parser for further ++explanation. ++ ++Note [Empty lists] ++~~~~~~~~~~~~~~~~~~ ++An empty list could be considered either a data constructor (stored with ++HsVar) or an ExplicitList. This Note describes how empty lists flow through the ++various phases and why. ++ ++Parsing ++------- ++An empty list is parsed by the sysdcon nonterminal. It thus comes to life via ++HsVar nilDataCon (defined in GHC.Builtin.Types). A freshly-parsed (HsExpr GhcPs) empty list ++is never a ExplicitList. ++ ++Renaming ++-------- ++If -XOverloadedLists is enabled, we must type-check the empty list as if it ++were a call to fromListN. (This is true regardless of the setting of ++-XRebindableSyntax.) This is very easy if the empty list is an ExplicitList, ++but an annoying special case if it's an HsVar. So the renamer changes a ++HsVar nilDataCon to an ExplicitList [], but only if -XOverloadedLists is on. ++(Why not always? Read on, dear friend.) This happens in the HsVar case of rnExpr. ++ ++Type-checking ++------------- ++We want to accept an expression like [] @Int. To do this, we must infer that ++[] :: forall a. [a]. This is easy if [] is a HsVar with the right DataCon inside. ++However, the type-checking for explicit lists works differently: [x,y,z] is never ++polymorphic. Instead, we unify the types of x, y, and z together, and use the ++unified type as the argument to the cons and nil constructors. Thus, treating ++[] as an empty ExplicitList in the type-checker would prevent [] @Int from working. ++ ++However, if -XOverloadedLists is on, then [] @Int really shouldn't be allowed: ++it's just like fromListN 0 [] @Int. Since ++ fromListN :: forall list. IsList list => Int -> [Item list] -> list ++that expression really should be rejected. Thus, the renamer's behaviour is ++exactly what we want: treat [] as a datacon when -XNoOverloadedLists, and as ++an empty ExplicitList when -XOverloadedLists. ++ ++See also #13680, which requested [] @Int to work. ++-} ++ ++ ++----------------------- ++pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc ++pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4)) ++ = ppr (src,(n1,n2),(n3,n4)) ++ ++{- ++HsSyn records exactly where the user put parens, with HsPar. ++So generally speaking we print without adding any parens. ++However, some code is internally generated, and in some places ++parens are absolutely required; so for these places we use ++pprParendLExpr (but don't print double parens of course). ++ ++For operator applications we don't add parens, because the operator ++fixities should do the job, except in debug mode (-dppr-debug) so we ++can see the structure of the parse tree. ++-} ++ ++{- ++************************************************************************ ++* * ++\subsection{Commands (in arrow abstractions)} ++* * ++************************************************************************ ++ ++We re-use HsExpr to represent these. ++-} ++ ++-- | Located Haskell Command (for arrow syntax) ++type LHsCmd id = XRec id (HsCmd id) ++ ++-- | Haskell Command (e.g. a "statement" in an Arrow proc block) ++data HsCmd id ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.Annlarrowtail', ++ -- 'GHC.Parser.Annotation.Annrarrowtail','GHC.Parser.Annotation.AnnLarrowtail', ++ -- 'GHC.Parser.Annotation.AnnRarrowtail' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ = HsCmdArrApp -- Arrow tail, or arrow application (f -< arg) ++ (XCmdArrApp id) -- type of the arrow expressions f, ++ -- of the form a t t', where arg :: t ++ (LHsExpr id) -- arrow expression, f ++ (LHsExpr id) -- input expression, arg ++ HsArrAppType -- higher-order (-<<) or first-order (-<) ++ Bool -- True => right-to-left (f -< arg) ++ -- False => left-to-right (arg >- f) ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpenB' @'(|'@, ++ -- 'GHC.Parser.Annotation.AnnCloseB' @'|)'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | HsCmdArrForm -- Command formation, (| e cmd1 .. cmdn |) ++ (XCmdArrForm id) ++ (LHsExpr id) -- The operator. ++ -- After type-checking, a type abstraction to be ++ -- applied to the type of the local environment tuple ++ LexicalFixity -- Whether the operator appeared prefix or infix when ++ -- parsed. ++ (Maybe Fixity) -- fixity (filled in by the renamer), for forms that ++ -- were converted from OpApp's by the renamer ++ [LHsCmdTop id] -- argument commands ++ ++ | HsCmdApp (XCmdApp id) ++ (LHsCmd id) ++ (LHsExpr id) ++ ++ | HsCmdLam (XCmdLam id) ++ (MatchGroup id (LHsCmd id)) -- kappa ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam', ++ -- 'GHC.Parser.Annotation.AnnRarrow', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsCmdPar (XCmdPar id) ++ (LHsCmd id) -- parenthesised command ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@, ++ -- 'GHC.Parser.Annotation.AnnClose' @')'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsCmdCase (XCmdCase id) ++ (LHsExpr id) ++ (MatchGroup id (LHsCmd id)) -- bodies are HsCmd's ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase', ++ -- 'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@, ++ -- 'GHC.Parser.Annotation.AnnClose' @'}'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsCmdLamCase (XCmdLamCase id) ++ (MatchGroup id (LHsCmd id)) -- bodies are HsCmd's ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam', ++ -- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen' @'{'@, ++ -- 'GHC.Parser.Annotation.AnnClose' @'}'@ ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsCmdIf (XCmdIf id) ++ (SyntaxExpr id) -- cond function ++ (LHsExpr id) -- predicate ++ (LHsCmd id) -- then part ++ (LHsCmd id) -- else part ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf', ++ -- 'GHC.Parser.Annotation.AnnSemi', ++ -- 'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi', ++ -- 'GHC.Parser.Annotation.AnnElse', ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsCmdLet (XCmdLet id) ++ (LHsLocalBinds id) -- let(rec) ++ (LHsCmd id) ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet', ++ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@, ++ -- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | HsCmdDo (XCmdDo id) -- Type of the whole expression ++ (XRec id [CmdLStmt id]) ++ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo', ++ -- 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnSemi', ++ -- 'GHC.Parser.Annotation.AnnVbar', ++ -- 'GHC.Parser.Annotation.AnnClose' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ ++ | XCmd !(XXCmd id) -- Note [Trees that Grow] extension point ++ ++ ++-- | Haskell Array Application Type ++data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp ++ deriving Data ++ ++ ++{- | Top-level command, introducing a new arrow. ++This may occur inside a proc (where the stack is empty) or as an ++argument of a command-forming operator. ++-} ++ ++-- | Located Haskell Top-level Command ++type LHsCmdTop p = XRec p (HsCmdTop p) ++ ++-- | Haskell Top-level Command ++data HsCmdTop p ++ = HsCmdTop (XCmdTop p) ++ (LHsCmd p) ++ | XCmdTop !(XXCmdTop p) -- Note [Trees that Grow] extension point ++ ++----------------------- ++ ++{- ++************************************************************************ ++* * ++\subsection{Record binds} ++* * ++************************************************************************ ++-} ++ ++-- | Haskell Record Bindings ++type HsRecordBinds p = HsRecFields p (LHsExpr p) ++ ++{- ++************************************************************************ ++* * ++\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes} ++* * ++************************************************************************ ++ ++@Match@es are sets of pattern bindings and right hand sides for ++functions, patterns or case branches. For example, if a function @g@ ++is defined as: ++\begin{verbatim} ++g (x,y) = y ++g ((x:ys),y) = y+1, ++\end{verbatim} ++then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@. ++ ++It is always the case that each element of an @[Match]@ list has the ++same number of @pats@s inside it. This corresponds to saying that ++a function defined by pattern matching must have the same number of ++patterns in each equation. ++-} ++ ++data MatchGroup p body ++ = MG { mg_ext :: XMG p body -- Post-typechecker, types of args and result ++ , mg_alts :: XRec p [LMatch p body] -- The alternatives ++ , mg_origin :: Origin } ++ -- The type is the type of the entire group ++ -- t1 -> ... -> tn -> tr ++ -- where there are n patterns ++ | XMatchGroup !(XXMatchGroup p body) ++ ++data MatchGroupTc ++ = MatchGroupTc ++ { mg_arg_tys :: [Scaled Type] -- Types of the arguments, t1..tn ++ , mg_res_ty :: Type -- Type of the result, tr ++ } deriving Data ++ ++-- | Located Match ++type LMatch id body = XRec id (Match id body) ++-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a ++-- list ++ ++-- For details on above see note [Api annotations] in GHC.Parser.Annotation ++data Match p body ++ = Match { ++ m_ext :: XCMatch p body, ++ m_ctxt :: HsMatchContext (NoGhcTc p), ++ -- See note [m_ctxt in Match] ++ m_pats :: [LPat p], -- The patterns ++ m_grhss :: (GRHSs p body) ++ } ++ | XMatch !(XXMatch p body) ++ ++{- ++Note [m_ctxt in Match] ++~~~~~~~~~~~~~~~~~~~~~~ ++ ++A Match can occur in a number of contexts, such as a FunBind, HsCase, HsLam and ++so on. ++ ++In order to simplify tooling processing and pretty print output, the provenance ++is captured in an HsMatchContext. ++ ++This is particularly important for the API Annotations for a multi-equation ++FunBind. ++ ++The parser initially creates a FunBind with a single Match in it for ++every function definition it sees. ++ ++These are then grouped together by getMonoBind into a single FunBind, ++where all the Matches are combined. ++ ++In the process, all the original FunBind fun_id's bar one are ++discarded, including the locations. ++ ++This causes a problem for source to source conversions via API ++Annotations, so the original fun_ids and infix flags are preserved in ++the Match, when it originates from a FunBind. ++ ++Example infix function definition requiring individual API Annotations ++ ++ (&&& ) [] [] = [] ++ xs &&& [] = xs ++ ( &&& ) [] ys = ys ++ ++ ++ ++-} ++ ++ ++isInfixMatch :: Match id body -> Bool ++isInfixMatch match = case m_ctxt match of ++ FunRhs {mc_fixity = Infix} -> True ++ _ -> False ++ ++-- | Guarded Right-Hand Sides ++-- ++-- GRHSs are used both for pattern bindings and for Matches ++-- ++-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVbar', ++-- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere', ++-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose' ++-- 'GHC.Parser.Annotation.AnnRarrow','GHC.Parser.Annotation.AnnSemi' ++ ++-- For details on above see note [Api annotations] in GHC.Parser.Annotation ++data GRHSs p body ++ = GRHSs { ++ grhssExt :: XCGRHSs p body, ++ grhssGRHSs :: [LGRHS p body], -- ^ Guarded RHSs ++ grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause ++ } ++ | XGRHSs !(XXGRHSs p body) ++ ++-- | Located Guarded Right-Hand Side ++type LGRHS id body = XRec id (GRHS id body) ++ ++-- | Guarded Right Hand Side. ++data GRHS p body = GRHS (XCGRHS p body) ++ [GuardLStmt p] -- Guards ++ body -- Right hand side ++ | XGRHS !(XXGRHS p body) ++ ++-- We know the list must have at least one @Match@ in it. ++ ++{- ++************************************************************************ ++* * ++\subsection{Do stmts and list comprehensions} ++* * ++************************************************************************ ++-} ++ ++-- | Located @do@ block Statement ++type LStmt id body = XRec id (StmtLR id id body) ++ ++-- | Located Statement with separate Left and Right id's ++type LStmtLR idL idR body = XRec idL (StmtLR idL idR body) ++ ++-- | @do@ block Statement ++type Stmt id body = StmtLR id id body ++ ++-- | Command Located Statement ++type CmdLStmt id = LStmt id (LHsCmd id) ++ ++-- | Command Statement ++type CmdStmt id = Stmt id (LHsCmd id) ++ ++-- | Expression Located Statement ++type ExprLStmt id = LStmt id (LHsExpr id) ++ ++-- | Expression Statement ++type ExprStmt id = Stmt id (LHsExpr id) ++ ++-- | Guard Located Statement ++type GuardLStmt id = LStmt id (LHsExpr id) ++ ++-- | Guard Statement ++type GuardStmt id = Stmt id (LHsExpr id) ++ ++-- | Ghci Located Statement ++type GhciLStmt id = LStmt id (LHsExpr id) ++ ++-- | Ghci Statement ++type GhciStmt id = Stmt id (LHsExpr id) ++ ++-- The SyntaxExprs in here are used *only* for do-notation and monad ++-- comprehensions, which have rebindable syntax. Otherwise they are unused. ++-- | API Annotations when in qualifier lists or guards ++-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVbar', ++-- 'GHC.Parser.Annotation.AnnComma','GHC.Parser.Annotation.AnnThen', ++-- 'GHC.Parser.Annotation.AnnBy','GHC.Parser.Annotation.AnnBy', ++-- 'GHC.Parser.Annotation.AnnGroup','GHC.Parser.Annotation.AnnUsing' ++ ++-- For details on above see note [Api annotations] in GHC.Parser.Annotation ++data StmtLR idL idR body -- body should always be (LHs**** idR) ++ = LastStmt -- Always the last Stmt in ListComp, MonadComp, ++ -- and (after the renamer, see GHC.Rename.Expr.checkLastStmt) DoExpr, MDoExpr ++ -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff ++ (XLastStmt idL idR body) ++ body ++ (Maybe Bool) -- Whether return was stripped ++ -- Just True <=> return with a dollar was stripped by ApplicativeDo ++ -- Just False <=> return without a dollar was stripped by ApplicativeDo ++ -- Nothing <=> Nothing was stripped ++ (SyntaxExpr idR) -- The return operator ++ -- The return operator is used only for MonadComp ++ -- For ListComp we use the baked-in 'return' ++ -- For DoExpr, MDoExpr, we don't apply a 'return' at all ++ -- See Note [Monad Comprehensions] ++ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLarrow' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | BindStmt (XBindStmt idL idR body) ++ -- ^ Post renaming has optional fail and bind / (>>=) operator. ++ -- Post typechecking, also has multiplicity of the argument ++ -- and the result type of the function passed to bind; ++ -- that is, (P, S) in (>>=) :: Q -> (R # P -> S) -> T ++ -- See Note [The type of bind in Stmts] ++ (LPat idL) ++ body ++ ++ -- | 'ApplicativeStmt' represents an applicative expression built with ++ -- '<$>' and '<*>'. It is generated by the renamer, and is desugared into the ++ -- appropriate applicative expression by the desugarer, but it is intended ++ -- to be invisible in error messages. ++ -- ++ -- For full details, see Note [ApplicativeDo] in "GHC.Rename.Expr" ++ -- ++ | ApplicativeStmt ++ (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body ++ [ ( SyntaxExpr idR ++ , ApplicativeArg idL) ] ++ -- [(<$>, e1), (<*>, e2), ..., (<*>, en)] ++ (Maybe (SyntaxExpr idR)) -- 'join', if necessary ++ ++ | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type ++ -- of the RHS (used for arrows) ++ body -- See Note [BodyStmt] ++ (SyntaxExpr idR) -- The (>>) operator ++ (SyntaxExpr idR) -- The `guard` operator; used only in MonadComp ++ -- See notes [Monad Comprehensions] ++ ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet' ++ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@, ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | LetStmt (XLetStmt idL idR body) (LHsLocalBindsLR idL idR) ++ ++ -- ParStmts only occur in a list/monad comprehension ++ | ParStmt (XParStmt idL idR body) -- Post typecheck, ++ -- S in (>>=) :: Q -> (R -> S) -> T ++ [ParStmtBlock idL idR] ++ (HsExpr idR) -- Polymorphic `mzip` for monad comprehensions ++ (SyntaxExpr idR) -- The `>>=` operator ++ -- See notes [Monad Comprehensions] ++ -- After renaming, the ids are the binders ++ -- bound by the stmts and used after themp ++ ++ | TransStmt { ++ trS_ext :: XTransStmt idL idR body, -- Post typecheck, ++ -- R in (>>=) :: Q -> (R -> S) -> T ++ trS_form :: TransForm, ++ trS_stmts :: [ExprLStmt idL], -- Stmts to the *left* of the 'group' ++ -- which generates the tuples to be grouped ++ ++ trS_bndrs :: [(IdP idR, IdP idR)], -- See Note [TransStmt binder map] ++ ++ trS_using :: LHsExpr idR, ++ trS_by :: Maybe (LHsExpr idR), -- "by e" (optional) ++ -- Invariant: if trS_form = GroupBy, then grp_by = Just e ++ ++ trS_ret :: SyntaxExpr idR, -- The monomorphic 'return' function for ++ -- the inner monad comprehensions ++ trS_bind :: SyntaxExpr idR, -- The '(>>=)' operator ++ trS_fmap :: HsExpr idR -- The polymorphic 'fmap' function for desugaring ++ -- Only for 'group' forms ++ -- Just a simple HsExpr, because it's ++ -- too polymorphic for tcSyntaxOp ++ } -- See Note [Monad Comprehensions] ++ ++ -- Recursive statement (see Note [How RecStmt works] below) ++ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRec' ++ ++ -- For details on above see note [Api annotations] in GHC.Parser.Annotation ++ | RecStmt ++ { recS_ext :: XRecStmt idL idR body ++ , recS_stmts :: [LStmtLR idL idR body] ++ ++ -- The next two fields are only valid after renaming ++ , recS_later_ids :: [IdP idR] ++ -- The ids are a subset of the variables bound by the ++ -- stmts that are used in stmts that follow the RecStmt ++ ++ , recS_rec_ids :: [IdP idR] ++ -- Ditto, but these variables are the "recursive" ones, ++ -- that are used before they are bound in the stmts of ++ -- the RecStmt. ++ -- An Id can be in both groups ++ -- Both sets of Ids are (now) treated monomorphically ++ -- See Note [How RecStmt works] for why they are separate ++ ++ -- Rebindable syntax ++ , recS_bind_fn :: SyntaxExpr idR -- The bind function ++ , recS_ret_fn :: SyntaxExpr idR -- The return function ++ , recS_mfix_fn :: SyntaxExpr idR -- The mfix function ++ } ++ | XStmtLR !(XXStmtLR idL idR body) ++ ++data TransForm -- The 'f' below is the 'using' function, 'e' is the by function ++ = ThenForm -- then f or then f by e (depending on trS_by) ++ | GroupForm -- then group using f or then group by e using f (depending on trS_by) ++ deriving Data ++ ++-- | Parenthesised Statement Block ++data ParStmtBlock idL idR ++ = ParStmtBlock ++ (XParStmtBlock idL idR) ++ [ExprLStmt idL] ++ [IdP idR] -- The variables to be returned ++ (SyntaxExpr idR) -- The return operator ++ | XParStmtBlock !(XXParStmtBlock idL idR) ++ ++-- | The fail operator ++-- ++-- This is used for `.. <-` "bind statments" in do notation, including ++-- non-monadic "binds" in applicative. ++-- ++-- The fail operator is 'Just expr' if it potentially fail monadically. if the ++-- pattern match cannot fail, or shouldn't fail monadically (regular incomplete ++-- pattern exception), it is 'Nothing'. ++-- ++-- See Note [Monad fail : Rebindable syntax, overloaded strings] for the type of ++-- expression in the 'Just' case, and why it is so. ++-- ++-- See Note [Failing pattern matches in Stmts] for which contexts for ++-- '@BindStmt@'s should use the monadic fail and which shouldn't. ++type FailOperator id = Maybe (SyntaxExpr id) ++ ++-- | Applicative Argument ++data ApplicativeArg idL ++ = ApplicativeArgOne -- A single statement (BindStmt or BodyStmt) ++ { xarg_app_arg_one :: XApplicativeArgOne idL ++ -- ^ The fail operator, after renaming ++ -- ++ -- The fail operator is needed if this is a BindStmt ++ -- where the pattern can fail. E.g.: ++ -- (Just a) <- stmt ++ -- The fail operator will be invoked if the pattern ++ -- match fails. ++ -- It is also used for guards in MonadComprehensions. ++ -- The fail operator is Nothing ++ -- if the pattern match can't fail ++ , app_arg_pattern :: LPat idL -- WildPat if it was a BodyStmt (see below) ++ , arg_expr :: LHsExpr idL ++ , is_body_stmt :: Bool ++ -- ^ True <=> was a BodyStmt, ++ -- False <=> was a BindStmt. ++ -- See Note [Applicative BodyStmt] ++ } ++ | ApplicativeArgMany -- do { stmts; return vars } ++ { xarg_app_arg_many :: XApplicativeArgMany idL ++ , app_stmts :: [ExprLStmt idL] -- stmts ++ , final_expr :: HsExpr idL -- return (v1,..,vn), or just (v1,..,vn) ++ , bv_pattern :: LPat idL -- (v1,...,vn) ++ , stmt_context :: HsStmtContext (ApplicativeArgStmCtxPass idL) ++ -- ^ context of the do expression, used in pprArg ++ } ++ | XApplicativeArg !(XXApplicativeArg idL) ++ ++type family ApplicativeArgStmCtxPass idL ++ ++{- ++Note [The type of bind in Stmts] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++Some Stmts, notably BindStmt, keep the (>>=) bind operator. ++We do NOT assume that it has type ++ (>>=) :: m a -> (a -> m b) -> m b ++In some cases (see #303, #1537) it might have a more ++exotic type, such as ++ (>>=) :: m i j a -> (a -> m j k b) -> m i k b ++So we must be careful not to make assumptions about the type. ++In particular, the monad may not be uniform throughout. ++ ++Note [TransStmt binder map] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++The [(idR,idR)] in a TransStmt behaves as follows: ++ ++ * Before renaming: [] ++ ++ * After renaming: ++ [ (x27,x27), ..., (z35,z35) ] ++ These are the variables ++ bound by the stmts to the left of the 'group' ++ and used either in the 'by' clause, ++ or in the stmts following the 'group' ++ Each item is a pair of identical variables. ++ ++ * After typechecking: ++ [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ] ++ Each pair has the same unique, but different *types*. ++ ++Note [BodyStmt] ++~~~~~~~~~~~~~~~ ++BodyStmts are a bit tricky, because what they mean ++depends on the context. Consider the following contexts: ++ ++ A do expression of type (m res_ty) ++ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++ * BodyStmt E any_ty: do { ....; E; ... } ++ E :: m any_ty ++ Translation: E >> ... ++ ++ A list comprehensions of type [elt_ty] ++ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++ * BodyStmt E Bool: [ .. | .... E ] ++ [ .. | ..., E, ... ] ++ [ .. | .... | ..., E | ... ] ++ E :: Bool ++ Translation: if E then fail else ... ++ ++ A guard list, guarding a RHS of type rhs_ty ++ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++ * BodyStmt E BooParStmtBlockl: f x | ..., E, ... = ...rhs... ++ E :: Bool ++ Translation: if E then fail else ... ++ ++ A monad comprehension of type (m res_ty) ++ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++ * BodyStmt E Bool: [ .. | .... E ] ++ E :: Bool ++ Translation: guard E >> ... ++ ++Array comprehensions are handled like list comprehensions. ++ ++Note [How RecStmt works] ++~~~~~~~~~~~~~~~~~~~~~~~~ ++Example: ++ HsDo [ BindStmt x ex ++ ++ , RecStmt { recS_rec_ids = [a, c] ++ , recS_stmts = [ BindStmt b (return (a,c)) ++ , LetStmt a = ...b... ++ , BindStmt c ec ] ++ , recS_later_ids = [a, b] ++ ++ , return (a b) ] ++ ++Here, the RecStmt binds a,b,c; but ++ - Only a,b are used in the stmts *following* the RecStmt, ++ - Only a,c are used in the stmts *inside* the RecStmt ++ *before* their bindings ++ ++Why do we need *both* rec_ids and later_ids? For monads they could be ++combined into a single set of variables, but not for arrows. That ++follows from the types of the respective feedback operators: ++ ++ mfix :: MonadFix m => (a -> m a) -> m a ++ loop :: ArrowLoop a => a (b,d) (c,d) -> a b c ++ ++* For mfix, the 'a' covers the union of the later_ids and the rec_ids ++* For 'loop', 'c' is the later_ids and 'd' is the rec_ids ++ ++Note [Typing a RecStmt] ++~~~~~~~~~~~~~~~~~~~~~~~ ++A (RecStmt stmts) types as if you had written ++ ++ (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) -> ++ do { stmts ++ ; return (v1,..vn, r1, ..., rm) }) ++ ++where v1..vn are the later_ids ++ r1..rm are the rec_ids ++ ++Note [Monad Comprehensions] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++Monad comprehensions require separate functions like 'return' and ++'>>=' for desugaring. These functions are stored in the statements ++used in monad comprehensions. For example, the 'return' of the 'LastStmt' ++expression is used to lift the body of the monad comprehension: ++ ++ [ body | stmts ] ++ => ++ stmts >>= \bndrs -> return body ++ ++In transform and grouping statements ('then ..' and 'then group ..') the ++'return' function is required for nested monad comprehensions, for example: ++ ++ [ body | stmts, then f, rest ] ++ => ++ f [ env | stmts ] >>= \bndrs -> [ body | rest ] ++ ++BodyStmts require the 'Control.Monad.guard' function for boolean ++expressions: ++ ++ [ body | exp, stmts ] ++ => ++ guard exp >> [ body | stmts ] ++ ++Parallel statements require the 'Control.Monad.Zip.mzip' function: ++ ++ [ body | stmts1 | stmts2 | .. ] ++ => ++ mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body ++ ++In any other context than 'MonadComp', the fields for most of these ++'SyntaxExpr's stay bottom. ++ ++ ++Note [Applicative BodyStmt] ++ ++(#12143) For the purposes of ApplicativeDo, we treat any BodyStmt ++as if it was a BindStmt with a wildcard pattern. For example, ++ ++ do ++ x <- A ++ B ++ return x ++ ++is transformed as if it were ++ ++ do ++ x <- A ++ _ <- B ++ return x ++ ++so it transforms to ++ ++ (\(x,_) -> x) <$> A <*> B ++ ++But we have to remember when we treat a BodyStmt like a BindStmt, ++because in error messages we want to emit the original syntax the user ++wrote, not our internal representation. So ApplicativeArgOne has a ++Bool flag that is True when the original statement was a BodyStmt, so ++that we can pretty-print it correctly. ++-} ++ ++ ++{- ++************************************************************************ ++* * ++ Template Haskell quotation brackets ++* * ++************************************************************************ ++-} ++ ++-- | Haskell Splice ++data HsSplice id ++ = HsTypedSplice -- $$z or $$(f 4) ++ (XTypedSplice id) ++ SpliceDecoration -- Whether $$( ) variant found, for pretty printing ++ (IdP id) -- A unique name to identify this splice point ++ (LHsExpr id) -- See Note [Pending Splices] ++ ++ | HsUntypedSplice -- $z or $(f 4) ++ (XUntypedSplice id) ++ SpliceDecoration -- Whether $( ) variant found, for pretty printing ++ (IdP id) -- A unique name to identify this splice point ++ (LHsExpr id) -- See Note [Pending Splices] ++ ++ | HsQuasiQuote -- See Note [Quasi-quote overview] in GHC.Tc.Gen.Splice ++ (XQuasiQuote id) ++ (IdP id) -- Splice point ++ (IdP id) -- Quoter ++ SrcSpan -- The span of the enclosed string ++ FastString -- The enclosed string ++ ++ -- AZ:TODO: use XSplice instead of HsSpliced ++ | HsSpliced -- See Note [Delaying modFinalizers in untyped splices] in ++ -- GHC.Rename.Splice. ++ -- This is the result of splicing a splice. It is produced by ++ -- the renamer and consumed by the typechecker. It lives only ++ -- between the two. ++ (XSpliced id) ++ ThModFinalizers -- TH finalizers produced by the splice. ++ (HsSplicedThing id) -- The result of splicing ++ | XSplice !(XXSplice id) -- Note [Trees that Grow] extension point ++ ++-- | A splice can appear with various decorations wrapped around it. This data ++-- type captures explicitly how it was originally written, for use in the pretty ++-- printer. ++data SpliceDecoration ++ = DollarSplice -- ^ $splice or $$splice ++ | BareSplice -- ^ bare splice ++ deriving (Data, Eq, Show) ++ ++instance Outputable SpliceDecoration where ++ ppr x = text $ show x ++ ++ ++isTypedSplice :: HsSplice id -> Bool ++isTypedSplice (HsTypedSplice {}) = True ++isTypedSplice _ = False -- Quasi-quotes are untyped splices ++ ++-- | Finalizers produced by a splice with ++-- 'Language.Haskell.TH.Syntax.addModFinalizer' ++-- ++-- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. For how ++-- this is used. ++-- ++newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())] ++ ++-- A Data instance which ignores the argument of 'ThModFinalizers'. ++instance Data ThModFinalizers where ++ gunfold _ z _ = z $ ThModFinalizers [] ++ toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix ++ dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a] ++ ++-- | Haskell Spliced Thing ++-- ++-- Values that can result from running a splice. ++data HsSplicedThing id ++ = HsSplicedExpr (HsExpr id) -- ^ Haskell Spliced Expression ++ | HsSplicedTy (HsType id) -- ^ Haskell Spliced Type ++ | HsSplicedPat (Pat id) -- ^ Haskell Spliced Pattern ++ ++ ++-- See Note [Pending Splices] ++type SplicePointName = Name ++ ++data UntypedSpliceFlavour ++ = UntypedExpSplice ++ | UntypedPatSplice ++ | UntypedTypeSplice ++ | UntypedDeclSplice ++ deriving Data ++ ++-- | Haskell Bracket ++data HsBracket p ++ = ExpBr (XExpBr p) (LHsExpr p) -- [| expr |] ++ | PatBr (XPatBr p) (LPat p) -- [p| pat |] ++ | DecBrL (XDecBrL p) [LHsDecl p] -- [d| decls |]; result of parser ++ | DecBrG (XDecBrG p) (HsGroup p) -- [d| decls |]; result of renamer ++ | TypBr (XTypBr p) (LHsType p) -- [t| type |] ++ | VarBr (XVarBr p) Bool (IdP p) -- True: 'x, False: ''T ++ -- (The Bool flag is used only in pprHsBracket) ++ | TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||] ++ | XBracket !(XXBracket p) -- Note [Trees that Grow] extension point ++ ++isTypedBracket :: HsBracket id -> Bool ++isTypedBracket (TExpBr {}) = True ++isTypedBracket _ = False ++ ++{- ++************************************************************************ ++* * ++\subsection{Enumerations and list comprehensions} ++* * ++************************************************************************ ++-} ++ ++-- | Arithmetic Sequence Information ++data ArithSeqInfo id ++ = From (LHsExpr id) ++ | FromThen (LHsExpr id) ++ (LHsExpr id) ++ | FromTo (LHsExpr id) ++ (LHsExpr id) ++ | FromThenTo (LHsExpr id) ++ (LHsExpr id) ++ (LHsExpr id) ++-- AZ: Should ArithSeqInfo have a TTG extension? ++ ++{- ++************************************************************************ ++* * ++\subsection{HsMatchCtxt} ++* * ++************************************************************************ ++-} ++ ++-- | Haskell Match Context ++-- ++-- Context of a pattern match. This is more subtle than it would seem. See Note ++-- [Varieties of pattern matches]. ++data HsMatchContext p ++ = FunRhs { mc_fun :: LIdP p -- ^ function binder of @f@ ++ , mc_fixity :: LexicalFixity -- ^ fixing of @f@ ++ , mc_strictness :: SrcStrictness -- ^ was @f@ banged? ++ -- See Note [FunBind vs PatBind] ++ } ++ -- ^A pattern matching on an argument of a ++ -- function binding ++ | LambdaExpr -- ^Patterns of a lambda ++ | CaseAlt -- ^Patterns and guards on a case alternative ++ | IfAlt -- ^Guards of a multi-way if alternative ++ | ProcExpr -- ^Patterns of a proc ++ | PatBindRhs -- ^A pattern binding eg [y] <- e = e ++ | PatBindGuards -- ^Guards of pattern bindings, e.g., ++ -- (Just b) | Just _ <- x = e ++ -- | otherwise = e' ++ ++ | RecUpd -- ^Record update [used only in GHC.HsToCore.Expr to ++ -- tell matchWrapper what sort of ++ -- runtime error message to generate] ++ ++ | StmtCtxt (HsStmtContext p) -- ^Pattern of a do-stmt, list comprehension, ++ -- pattern guard, etc ++ ++ | ThPatSplice -- ^A Template Haskell pattern splice ++ | ThPatQuote -- ^A Template Haskell pattern quotation [p| (a,b) |] ++ | PatSyn -- ^A pattern synonym declaration ++ ++isPatSynCtxt :: HsMatchContext p -> Bool ++isPatSynCtxt ctxt = ++ case ctxt of ++ PatSyn -> True ++ _ -> False ++ ++-- | Haskell Statement Context. ++data HsStmtContext p ++ = ListComp ++ | MonadComp ++ ++ | DoExpr (Maybe ModuleName) -- ^[ModuleName.]do { ... } ++ | MDoExpr (Maybe ModuleName) -- ^[ModuleName.]mdo { ... } ie recursive do-expression ++ | ArrowExpr -- ^do-notation in an arrow-command context ++ ++ | GhciStmtCtxt -- ^A command-line Stmt in GHCi pat <- rhs ++ | PatGuard (HsMatchContext p) -- ^Pattern guard for specified thing ++ | ParStmtCtxt (HsStmtContext p) -- ^A branch of a parallel stmt ++ | TransStmtCtxt (HsStmtContext p) -- ^A branch of a transform stmt ++ ++qualifiedDoModuleName_maybe :: HsStmtContext p -> Maybe ModuleName ++qualifiedDoModuleName_maybe ctxt = case ctxt of ++ DoExpr m -> m ++ MDoExpr m -> m ++ _ -> Nothing ++ ++isComprehensionContext :: HsStmtContext id -> Bool ++-- Uses comprehension syntax [ e | quals ] ++isComprehensionContext ListComp = True ++isComprehensionContext MonadComp = True ++isComprehensionContext (ParStmtCtxt c) = isComprehensionContext c ++isComprehensionContext (TransStmtCtxt c) = isComprehensionContext c ++isComprehensionContext _ = False ++ ++-- | Is this a monadic context? ++isMonadStmtContext :: HsStmtContext id -> Bool ++isMonadStmtContext MonadComp = True ++isMonadStmtContext DoExpr{} = True ++isMonadStmtContext MDoExpr{} = True ++isMonadStmtContext GhciStmtCtxt = True ++isMonadStmtContext (ParStmtCtxt ctxt) = isMonadStmtContext ctxt ++isMonadStmtContext (TransStmtCtxt ctxt) = isMonadStmtContext ctxt ++isMonadStmtContext _ = False -- ListComp, PatGuard, ArrowExpr ++ ++isMonadCompContext :: HsStmtContext id -> Bool ++isMonadCompContext MonadComp = True ++isMonadCompContext _ = False ++ ++matchSeparator :: HsMatchContext p -> SDoc ++matchSeparator (FunRhs {}) = text "=" ++matchSeparator CaseAlt = text "->" ++matchSeparator IfAlt = text "->" ++matchSeparator LambdaExpr = text "->" ++matchSeparator ProcExpr = text "->" ++matchSeparator PatBindRhs = text "=" ++matchSeparator PatBindGuards = text "=" ++matchSeparator (StmtCtxt _) = text "<-" ++matchSeparator RecUpd = text "=" -- This can be printed by the pattern ++ -- match checker trace ++matchSeparator ThPatSplice = panic "unused" ++matchSeparator ThPatQuote = panic "unused" ++matchSeparator PatSyn = panic "unused" ++ ++pprMatchContext :: (Outputable (IdP p), UnXRec p) ++ => HsMatchContext p -> SDoc ++pprMatchContext ctxt ++ | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt ++ | otherwise = text "a" <+> pprMatchContextNoun ctxt ++ where ++ want_an (FunRhs {}) = True -- Use "an" in front ++ want_an ProcExpr = True ++ want_an _ = False ++ ++pprMatchContextNoun :: forall p. (Outputable (IdP p), UnXRec p) ++ => HsMatchContext p -> SDoc ++pprMatchContextNoun (FunRhs {mc_fun=fun}) ++ = text "equation for" ++ <+> quotes (ppr (unXRec @p fun)) ++pprMatchContextNoun CaseAlt = text "case alternative" ++pprMatchContextNoun IfAlt = text "multi-way if alternative" ++pprMatchContextNoun RecUpd = text "record-update construct" ++pprMatchContextNoun ThPatSplice = text "Template Haskell pattern splice" ++pprMatchContextNoun ThPatQuote = text "Template Haskell pattern quotation" ++pprMatchContextNoun PatBindRhs = text "pattern binding" ++pprMatchContextNoun PatBindGuards = text "pattern binding guards" ++pprMatchContextNoun LambdaExpr = text "lambda abstraction" ++pprMatchContextNoun ProcExpr = text "arrow abstraction" ++pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in" ++ $$ pprAStmtContext ctxt ++pprMatchContextNoun PatSyn = text "pattern synonym declaration" ++ ++----------------- ++pprAStmtContext, pprStmtContext :: (Outputable (IdP p), UnXRec p) ++ => HsStmtContext p -> SDoc ++pprAStmtContext ctxt = article <+> pprStmtContext ctxt ++ where ++ pp_an = text "an" ++ pp_a = text "a" ++ article = case ctxt of ++ MDoExpr Nothing -> pp_an ++ GhciStmtCtxt -> pp_an ++ _ -> pp_a ++ ++ ++----------------- ++pprStmtContext GhciStmtCtxt = text "interactive GHCi command" ++pprStmtContext (DoExpr m) = prependQualified m (text "'do' block") ++pprStmtContext (MDoExpr m) = prependQualified m (text "'mdo' block") ++pprStmtContext ArrowExpr = text "'do' block in an arrow command" ++pprStmtContext ListComp = text "list comprehension" ++pprStmtContext MonadComp = text "monad comprehension" ++pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt ++ ++-- Drop the inner contexts when reporting errors, else we get ++-- Unexpected transform statement ++-- in a transformed branch of ++-- transformed branch of ++-- transformed branch of monad comprehension ++pprStmtContext (ParStmtCtxt c) = ++ ifPprDebug (sep [text "parallel branch of", pprAStmtContext c]) ++ (pprStmtContext c) ++pprStmtContext (TransStmtCtxt c) = ++ ifPprDebug (sep [text "transformed branch of", pprAStmtContext c]) ++ (pprStmtContext c) ++ ++prependQualified :: Maybe ModuleName -> SDoc -> SDoc ++prependQualified Nothing t = t ++prependQualified (Just _) t = text "qualified" <+> t +diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs +index 9b8b2e3fcb..769efb7fd6 100644 +--- a/compiler/cmm/CmmNode.hs ++++ b/compiler/cmm/CmmNode.hs +@@ -33,7 +33,7 @@ import FastString + import ForeignCall + import Outputable + import SMRep +-import CoreSyn (Tickish) ++import CoreSyn (CmmTickish) + import qualified Unique as U + + import Hoopl.Block +@@ -620,9 +620,6 @@ mapCollectSuccessors _ n = (n, []) + + -- ----------------------------------------------------------------------------- + +--- | Tickish in Cmm context (annotations only) +-type CmmTickish = Tickish () +- + -- | Tick scope identifier, allowing us to reason about what + -- annotations in a Cmm block should scope over. We especially take + -- care to allow optimisations to reorganise blocks without losing +diff --git a/compiler/cmm/CmmParse.hs b/compiler/cmm/CmmParse.hs +index e7527f8e50..454c0efd21 100644 +--- a/compiler/cmm/CmmParse.hs ++++ b/compiler/cmm/CmmParse.hs +@@ -220,7 +220,7 @@ import GHC.StgToCmm.Closure + import GHC.StgToCmm.Layout hiding (ArgRep(..)) + import GHC.StgToCmm.Ticky + import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame ) +-import CoreSyn ( Tickish(SourceNote) ) ++import CoreSyn ( GenTickish(SourceNote) ) + + import CmmOpt + import MkGraph +diff --git a/compiler/cmm/CmmParse.y.source b/compiler/cmm/CmmParse.y.source +index e7527f8e50..454c0efd21 100644 +--- a/compiler/cmm/CmmParse.y.source ++++ b/compiler/cmm/CmmParse.y.source +@@ -220,7 +220,7 @@ import GHC.StgToCmm.Closure + import GHC.StgToCmm.Layout hiding (ArgRep(..)) + import GHC.StgToCmm.Ticky + import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame ) +-import CoreSyn ( Tickish(SourceNote) ) ++import CoreSyn ( GenTickish(SourceNote) ) + + import CmmOpt + import MkGraph +diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs +index 7f52054496..2d7421634b 100644 +--- a/compiler/coreSyn/CoreFVs.hs ++++ b/compiler/coreSyn/CoreFVs.hs +@@ -6,6 +6,7 @@ Taken quite directly from the Peyton Jones/Lester paper. + -} + + {-# LANGUAGE CPP #-} ++{-# LANGUAGE TypeFamilies #-} + + -- | A module concerned with finding the free variables of an expression. + module CoreFVs ( +@@ -289,8 +290,8 @@ rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV` + exprs_fvs :: [CoreExpr] -> FV + exprs_fvs exprs = mapUnionFV expr_fvs exprs + +-tickish_fvs :: Tickish Id -> FV +-tickish_fvs (Breakpoint _ ids) = FV.mkFVs ids ++tickish_fvs :: CoreTickish -> FV ++tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids + tickish_fvs _ = emptyFV + + {- +@@ -771,8 +772,8 @@ freeVars = go + , AnnTick tickish expr2 ) + where + expr2 = go expr +- tickishFVs (Breakpoint _ ids) = mkDVarSet ids +- tickishFVs _ = emptyDVarSet ++ tickishFVs (Breakpoint _ _ ids) = mkDVarSet ids ++ tickishFVs _ = emptyDVarSet + + go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty) + go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co) +diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs +index def51f5010..f5a3d0f713 100644 +--- a/compiler/coreSyn/CoreLint.hs ++++ b/compiler/coreSyn/CoreLint.hs +@@ -15,6 +15,8 @@ module CoreLint ( + lintPassResult, lintInteractiveExpr, lintExpr, + lintAnnots, lintTypes, + ++ interactiveInScope, ++ + -- ** Debug output + endPass, endPassIO, + dumpPassResult, +@@ -735,10 +737,10 @@ lintCoreExpr (Cast expr co) + + lintCoreExpr (Tick tickish expr) + = do case tickish of +- Breakpoint _ ids -> forM_ ids $ \id -> do +- checkDeadIdOcc id +- lookupIdInScope id +- _ -> return () ++ Breakpoint _ _ ids -> forM_ ids $ \id -> do ++ checkDeadIdOcc id ++ lookupIdInScope id ++ _ -> return () + markAllJoinsBadIf block_joins $ lintCoreExpr expr + where + block_joins = not (tickish `tickishScopesLike` SoftScope) +diff --git a/compiler/coreSyn/CoreMap.hs b/compiler/coreSyn/CoreMap.hs +index d50dcbf1bc..73f8a75d54 100644 +--- a/compiler/coreSyn/CoreMap.hs ++++ b/compiler/coreSyn/CoreMap.hs +@@ -343,11 +343,11 @@ xtE (D env (Case e b ty as)) f m + in xtList (xtA env1) as f } + + -- TODO: this seems a bit dodgy, see 'eqTickish' +-type TickishMap a = Map.Map (Tickish Id) a +-lkTickish :: Tickish Id -> TickishMap a -> Maybe a ++type TickishMap a = Map.Map CoreTickish a ++lkTickish :: CoreTickish -> TickishMap a -> Maybe a + lkTickish = lookupTM + +-xtTickish :: Tickish Id -> XT a -> TickishMap a -> TickishMap a ++xtTickish :: CoreTickish -> XT a -> TickishMap a -> TickishMap a + xtTickish = alterTM + + ------------------------ +diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs +index 3b528869fd..3c22d34ebd 100644 +--- a/compiler/coreSyn/CoreOpt.hs ++++ b/compiler/coreSyn/CoreOpt.hs +@@ -1169,7 +1169,7 @@ Currently, it is used in Rules.match, and is required to make + -} + + exprIsLambda_maybe :: InScopeEnv -> CoreExpr +- -> Maybe (Var, CoreExpr,[Tickish Id]) ++ -> Maybe (Var, CoreExpr,[CoreTickish]) + -- See Note [exprIsLambda_maybe] + + -- The simple case: It is a lambda already +diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs +index 09f53276bd..fa5a32cb4d 100644 +--- a/compiler/coreSyn/CorePrep.hs ++++ b/compiler/coreSyn/CorePrep.hs +@@ -636,9 +636,9 @@ cpeRhsE env (Tick tickish expr) + = do { body <- cpeBodyNF env expr + ; return (emptyFloats, mkTick tickish' body) } + where +- tickish' | Breakpoint n fvs <- tickish ++ tickish' | Breakpoint ext n fvs <- tickish + -- See also 'substTickish' +- = Breakpoint n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) ++ = Breakpoint ext n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) + | otherwise + = tickish + +@@ -784,7 +784,7 @@ rhsToBody expr = return (emptyFloats, expr) + + data ArgInfo = CpeApp CoreArg + | CpeCast Coercion +- | CpeTick (Tickish Id) ++ | CpeTick CoreTickish + + {- Note [runRW arg] + ~~~~~~~~~~~~~~~~~~~ +@@ -1218,7 +1218,7 @@ data FloatingBind + Bool -- The bool indicates "ok-for-speculation" + + -- | See Note [Floating Ticks in CorePrep] +- | FloatTick (Tickish Id) ++ | FloatTick CoreTickish + + data Floats = Floats OkToSpec (OrdList FloatingBind) + +diff --git a/compiler/coreSyn/CoreSeq.hs b/compiler/coreSyn/CoreSeq.hs +index 7de8923a71..a0b5f2ee17 100644 +--- a/compiler/coreSyn/CoreSeq.hs ++++ b/compiler/coreSyn/CoreSeq.hs +@@ -20,7 +20,7 @@ import VarSet( seqDVarSet ) + import Var( varType, tyVarKind ) + import Type( seqType, isTyVar ) + import Coercion( seqCo ) +-import Id( Id, idInfo ) ++import Id( idInfo ) + + -- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the + -- compiler +@@ -69,7 +69,7 @@ seqExprs :: [CoreExpr] -> () + seqExprs [] = () + seqExprs (e:es) = seqExpr e `seq` seqExprs es + +-seqTickish :: Tickish Id -> () ++seqTickish :: CoreTickish -> () + seqTickish ProfNote{ profNoteCC = cc } = cc `seq` () + seqTickish HpcTick{} = () + seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids +diff --git a/compiler/coreSyn/CoreStats.hs b/compiler/coreSyn/CoreStats.hs +index fde107b372..a03d62472f 100644 +--- a/compiler/coreSyn/CoreStats.hs ++++ b/compiler/coreSyn/CoreStats.hs +@@ -116,7 +116,7 @@ exprSize (Tick n e) = tickSize n + exprSize e + exprSize (Type _) = 1 + exprSize (Coercion _) = 1 + +-tickSize :: Tickish Id -> Int ++tickSize :: CoreTickish -> Int + tickSize (ProfNote _ _ _) = 1 + tickSize _ = 1 + +diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs +index 0eedca4201..1675b16318 100644 +--- a/compiler/coreSyn/CoreSubst.hs ++++ b/compiler/coreSyn/CoreSubst.hs +@@ -705,9 +705,9 @@ substDVarSet subst fvs + | otherwise = tyCoFVsOfType (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc + + ------------------ +-substTickish :: Subst -> Tickish Id -> Tickish Id +-substTickish subst (Breakpoint n ids) +- = Breakpoint n (map do_one ids) ++substTickish :: Subst -> CoreTickish -> CoreTickish ++substTickish subst (Breakpoint ext n ids) ++ = Breakpoint ext n (map do_one ids) + where + do_one = getIdFromTrivialExpr . lookupIdSubst (text "subst_tickish") subst + substTickish _subst other = other +diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs +index e3ad4715f1..9655d3ad09 100644 +--- a/compiler/coreSyn/CoreSyn.hs ++++ b/compiler/coreSyn/CoreSyn.hs +@@ -6,12 +6,18 @@ + {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts #-} + {-# LANGUAGE NamedFieldPuns #-} + {-# LANGUAGE BangPatterns #-} ++{-# LANGUAGE KindSignatures #-} ++{-# LANGUAGE DataKinds #-} ++{-# LANGUAGE StandaloneDeriving #-} ++{-# LANGUAGE TypeFamilies #-} ++{-# LANGUAGE FlexibleInstances #-} + + -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection + module CoreSyn ( + -- * Main data types + Expr(..), Alt, Bind(..), AltCon(..), Arg, +- Tickish(..), TickishScoping(..), TickishPlacement(..), ++ CoreTickish, StgTickish, CmmTickish, XTickishId, ++ GenTickish(..), TickishScoping(..), TickishPlacement(..), + CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, + TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr, + +@@ -118,6 +124,8 @@ import UniqSet + import SrcLoc ( RealSrcSpan, containsSpan ) + import Binary + ++import GHC.Hs.Extension ( NoExtField ) ++ + import Data.Data hiding (TyCon) + import Data.Int + import Data.Word +@@ -260,7 +268,7 @@ data Expr b + | Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] + -- and Note [Why does Case have a 'Type' field?] + | Cast (Expr b) Coercion +- | Tick (Tickish Id) (Expr b) ++ | Tick CoreTickish (Expr b) + | Type Type + | Coercion Coercion + deriving Data +@@ -932,9 +940,31 @@ type MOutCoercion = MCoercion + + -- | Allows attaching extra information to points in expressions + ++-- | Used as a data type index for the GenTickish annotations ++data TickishPass ++ = TickishCore ++ | TickishStg ++ | TickishCmm ++ ++type family XBreakpoint (pass :: TickishPass) ++type instance XBreakpoint 'TickishCore = NoExtField ++-- | Keep track of the type of breakpoints in STG, for GHCi ++type instance XBreakpoint 'TickishStg = Type ++type instance XBreakpoint 'TickishCmm = NoExtField ++ ++type family XTickishId (pass :: TickishPass) ++type instance XTickishId 'TickishCore = Id ++type instance XTickishId 'TickishStg = Id ++type instance XTickishId 'TickishCmm = NoExtField ++ ++type CoreTickish = GenTickish 'TickishCore ++type StgTickish = GenTickish 'TickishStg ++-- | Tickish in Cmm context (annotations only) ++type CmmTickish = GenTickish 'TickishCmm ++ + -- If you edit this type, you may need to update the GHC formalism + -- See Note [GHC Formalism] in coreSyn/CoreLint.hs +-data Tickish id = ++data GenTickish pass = + -- | An @{-# SCC #-}@ profiling annotation, either automatically + -- added by the desugarer as a result of -auto-all, or added by + -- the user. +@@ -959,8 +989,10 @@ data Tickish id = + -- NB. we must take account of these Ids when (a) counting free variables, + -- and (b) substituting (don't substitute for them) + | Breakpoint +- { breakpointId :: !Int +- , breakpointFVs :: [id] -- ^ the order of this list is important: ++ { breakpointExt :: XBreakpoint pass ++ , breakpointId :: !Int ++ , breakpointFVs :: [XTickishId pass] ++ -- ^ the order of this list is important: + -- it matches the order of the lists in the + -- appropriate entry in HscTypes.ModBreaks. + -- +@@ -990,7 +1022,16 @@ data Tickish id = + -- (uses same names as CCs) + } + +- deriving (Eq, Ord, Data) ++deriving instance Eq (GenTickish 'TickishCore) ++deriving instance Ord (GenTickish 'TickishCore) ++deriving instance Data (GenTickish 'TickishCore) ++ ++deriving instance Data (GenTickish 'TickishStg) ++ ++deriving instance Eq (GenTickish 'TickishCmm) ++deriving instance Ord (GenTickish 'TickishCmm) ++deriving instance Data (GenTickish 'TickishCmm) ++ + + -- | A "counting tick" (where tickishCounts is True) is one that + -- counts evaluations in some way. We cannot discard a counting tick, +@@ -1000,7 +1041,7 @@ data Tickish id = + -- However, we still allow the simplifier to increase or decrease + -- sharing, so in practice the actual number of ticks may vary, except + -- that we never change the value from zero to non-zero or vice versa. +-tickishCounts :: Tickish id -> Bool ++tickishCounts :: GenTickish pass -> Bool + tickishCounts n@ProfNote{} = profNoteCount n + tickishCounts HpcTick{} = True + tickishCounts Breakpoint{} = True +@@ -1069,7 +1110,7 @@ data TickishScoping = + deriving (Eq) + + -- | Returns the intended scoping rule for a Tickish +-tickishScoped :: Tickish id -> TickishScoping ++tickishScoped :: GenTickish pass -> TickishScoping + tickishScoped n@ProfNote{} + | profNoteScope n = CostCentreScope + | otherwise = NoScope +@@ -1082,7 +1123,7 @@ tickishScoped SourceNote{} = SoftScope + + -- | Returns whether the tick scoping rule is at least as permissive + -- as the given scoping rule. +-tickishScopesLike :: Tickish id -> TickishScoping -> Bool ++tickishScopesLike :: GenTickish pass -> TickishScoping -> Bool + tickishScopesLike t scope = tickishScoped t `like` scope + where NoScope `like` _ = True + _ `like` NoScope = False +@@ -1101,24 +1142,24 @@ tickishScopesLike t scope = tickishScoped t `like` scope + -- @tickishCounts@. Note that in principle splittable ticks can become + -- floatable using @mkNoTick@ -- even though there's currently no + -- tickish for which that is the case. +-tickishFloatable :: Tickish id -> Bool ++tickishFloatable :: GenTickish pass -> Bool + tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t) + + -- | Returns @True@ for a tick that is both counting /and/ scoping and + -- can be split into its (tick, scope) parts using 'mkNoScope' and + -- 'mkNoTick' respectively. +-tickishCanSplit :: Tickish id -> Bool ++tickishCanSplit :: GenTickish pass -> Bool + tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True} + = True + tickishCanSplit _ = False + +-mkNoCount :: Tickish id -> Tickish id ++mkNoCount :: GenTickish pass -> GenTickish pass + mkNoCount n | not (tickishCounts n) = n + | not (tickishCanSplit n) = panic "mkNoCount: Cannot split!" + mkNoCount n@ProfNote{} = n {profNoteCount = False} + mkNoCount _ = panic "mkNoCount: Undefined split!" + +-mkNoScope :: Tickish id -> Tickish id ++mkNoScope :: GenTickish pass -> GenTickish pass + mkNoScope n | tickishScoped n == NoScope = n + | not (tickishCanSplit n) = panic "mkNoScope: Cannot split!" + mkNoScope n@ProfNote{} = n {profNoteScope = False} +@@ -1139,7 +1180,7 @@ mkNoScope _ = panic "mkNoScope: Undefined split!" + -- Here there is just no operational difference between the first and + -- the second version. Therefore code generation should simply + -- translate the code as if it found the latter. +-tickishIsCode :: Tickish id -> Bool ++tickishIsCode :: GenTickish pass -> Bool + tickishIsCode SourceNote{} = False + tickishIsCode _tickish = True -- all the rest for now + +@@ -1179,7 +1220,7 @@ data TickishPlacement = + deriving (Eq) + + -- | Placement behaviour we want for the ticks +-tickishPlace :: Tickish id -> TickishPlacement ++tickishPlace :: GenTickish pass -> TickishPlacement + tickishPlace n@ProfNote{} + | profNoteCount n = PlaceRuntime + | otherwise = PlaceCostCentre +@@ -1189,7 +1230,8 @@ tickishPlace SourceNote{} = PlaceNonLam + + -- | Returns whether one tick "contains" the other one, therefore + -- making the second tick redundant. +-tickishContains :: Eq b => Tickish b -> Tickish b -> Bool ++tickishContains :: Eq (GenTickish pass) ++ => GenTickish pass -> GenTickish pass -> Bool + tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2) + = containsSpan sp1 sp2 && n1 == n2 + -- compare the String last +@@ -2187,8 +2229,8 @@ stripNArgs _ _ = Nothing + + -- | Like @collectArgs@, but also collects looks through floatable + -- ticks if it means that we can find more arguments. +-collectArgsTicks :: (Tickish Id -> Bool) -> Expr b +- -> (Expr b, [Arg b], [Tickish Id]) ++collectArgsTicks :: (CoreTickish -> Bool) -> Expr b ++ -> (Expr b, [Arg b], [CoreTickish]) + collectArgsTicks skipTick expr + = go expr [] [] + where +@@ -2273,7 +2315,7 @@ data AnnExpr' bndr annot + | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot) + | AnnCast (AnnExpr bndr annot) (annot, Coercion) + -- Put an annotation on the (root of) the coercion +- | AnnTick (Tickish Id) (AnnExpr bndr annot) ++ | AnnTick CoreTickish (AnnExpr bndr annot) + | AnnType Type + | AnnCoercion Coercion + +@@ -2294,8 +2336,8 @@ collectAnnArgs expr + go (_, AnnApp f a) as = go f (a:as) + go e as = (e, as) + +-collectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a +- -> (AnnExpr b a, [AnnExpr b a], [Tickish Var]) ++collectAnnArgsTicks :: (CoreTickish -> Bool) -> AnnExpr b a ++ -> (AnnExpr b a, [AnnExpr b a], [CoreTickish]) + collectAnnArgsTicks tickishOk expr + = go expr [] [] + where +diff --git a/compiler/coreSyn/CoreTidy.hs b/compiler/coreSyn/CoreTidy.hs +index 3c924663f5..e6009445cb 100644 +--- a/compiler/coreSyn/CoreTidy.hs ++++ b/compiler/coreSyn/CoreTidy.hs +@@ -86,8 +86,9 @@ tidyAlt env (con, vs, rhs) + (con, vs, tidyExpr env' rhs) + + ------------ Tickish -------------- +-tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id +-tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids) ++tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish ++tidyTickish env (Breakpoint ext ix ids) ++ = Breakpoint ext ix (map (tidyVarOcc env) ids) + tidyTickish _ other_tickish = other_tickish + + ------------ Rules -------------- +diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs +index 16f4a00341..283a9c7fdd 100644 +--- a/compiler/coreSyn/CoreUtils.hs ++++ b/compiler/coreSyn/CoreUtils.hs +@@ -295,7 +295,7 @@ mkCast expr co + + -- | Wraps the given expression in the source annotation, dropping the + -- annotation if possible. +-mkTick :: Tickish Id -> CoreExpr -> CoreExpr ++mkTick :: CoreTickish -> CoreExpr -> CoreExpr + mkTick t orig_expr = mkTick' id id orig_expr + where + -- Some ticks (cost-centres) can be split in two, with the +@@ -380,7 +380,7 @@ mkTick t orig_expr = mkTick' id id orig_expr + -- Catch-all: Annotate where we stand + _any -> top $ Tick t $ rest expr + +-mkTicks :: [Tickish Id] -> CoreExpr -> CoreExpr ++mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr + mkTicks ticks expr = foldr mkTick expr ticks + + isSaturatedConApp :: CoreExpr -> Bool +@@ -391,13 +391,13 @@ isSaturatedConApp e = go e [] + go (Cast f _) as = go f as + go _ _ = False + +-mkTickNoHNF :: Tickish Id -> CoreExpr -> CoreExpr ++mkTickNoHNF :: CoreTickish -> CoreExpr -> CoreExpr + mkTickNoHNF t e + | exprIsHNF e = tickHNFArgs t e + | otherwise = mkTick t e + + -- push a tick into the arguments of a HNF (call or constructor app) +-tickHNFArgs :: Tickish Id -> CoreExpr -> CoreExpr ++tickHNFArgs :: CoreTickish -> CoreExpr -> CoreExpr + tickHNFArgs t e = push t e + where + push t (App f (Type u)) = App (push t f) (Type u) +@@ -405,28 +405,28 @@ tickHNFArgs t e = push t e + push _t e = e + + -- | Strip ticks satisfying a predicate from top of an expression +-stripTicksTop :: (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b) ++stripTicksTop :: (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b) + stripTicksTop p = go [] + where go ts (Tick t e) | p t = go (t:ts) e + go ts other = (reverse ts, other) + + -- | Strip ticks satisfying a predicate from top of an expression, + -- returning the remaining expression +-stripTicksTopE :: (Tickish Id -> Bool) -> Expr b -> Expr b ++stripTicksTopE :: (CoreTickish -> Bool) -> Expr b -> Expr b + stripTicksTopE p = go + where go (Tick t e) | p t = go e + go other = other + + -- | Strip ticks satisfying a predicate from top of an expression, + -- returning the ticks +-stripTicksTopT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id] ++stripTicksTopT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish] + stripTicksTopT p = go [] + where go ts (Tick t e) | p t = go (t:ts) e + go ts _ = ts + + -- | Completely strip ticks satisfying a predicate from an + -- expression. Note this is O(n) in the size of the expression! +-stripTicksE :: (Tickish Id -> Bool) -> Expr b -> Expr b ++stripTicksE :: (CoreTickish -> Bool) -> Expr b -> Expr b + stripTicksE p expr = go expr + where go (App e a) = App (go e) (go a) + go (Lam b e) = Lam b (go e) +@@ -442,7 +442,7 @@ stripTicksE p expr = go expr + go_b (b, e) = (b, go e) + go_a (c,bs,e) = (c,bs, go e) + +-stripTicksT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id] ++stripTicksT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish] + stripTicksT p expr = fromOL $ go expr + where go (App e a) = go e `appOL` go a + go (Lam _ e) = go e +@@ -2059,7 +2059,7 @@ cheapEqExpr :: Expr b -> Expr b -> Bool + cheapEqExpr = cheapEqExpr' (const False) + + -- | Cheap expression equality test, can ignore ticks by type. +-cheapEqExpr' :: (Tickish Id -> Bool) -> Expr b -> Expr b -> Bool ++cheapEqExpr' :: (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool + cheapEqExpr' ignoreTick = go_s + where go_s = go `on` stripTicksTopE ignoreTick + go (Var v1) (Var v2) = v1 == v2 +@@ -2136,8 +2136,8 @@ eqExpr in_scope e1 e2 + go_alt env (c1, bs1, e1) (c2, bs2, e2) + = c1 == c2 && go (rnBndrs2 env bs1 bs2) e1 e2 + +-eqTickish :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool +-eqTickish env (Breakpoint lid lids) (Breakpoint rid rids) ++eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool ++eqTickish env (Breakpoint _ lid lids) (Breakpoint _ rid rids) + = lid == rid && map (rnOccL env) lids == map (rnOccR env) rids + eqTickish _ l r = l == r + +@@ -2443,7 +2443,7 @@ tryEtaReduce bndrs body + -> Coercion -- Of kind (t1~t2) + -> Maybe (Coercion -- Of type (arg_t -> t1 ~ bndr_t -> t2) + -- (and similarly for tyvars, coercion args) +- , [Tickish Var]) ++ , [CoreTickish]) + -- See Note [Eta reduction with casted arguments] + ok_arg bndr (Type ty) co + | Just tv <- getTyVar_maybe ty +diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs +index c959fc1c4e..e78e5f6b0f 100644 +--- a/compiler/coreSyn/PprCore.hs ++++ b/compiler/coreSyn/PprCore.hs +@@ -7,6 +7,8 @@ Printing of Core syntax + -} + + {-# LANGUAGE MultiWayIf #-} ++{-# LANGUAGE FlexibleContexts #-} ++{-# LANGUAGE UndecidableInstances #-} + {-# OPTIONS_GHC -fno-warn-orphans #-} + module PprCore ( + pprCoreExpr, pprParendExpr, +@@ -597,13 +599,13 @@ pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn, + ----------------------------------------------------- + -} + +-instance Outputable id => Outputable (Tickish id) where ++instance Outputable (XTickishId pass) => Outputable (GenTickish pass) where + ppr (HpcTick modl ix) = + hcat [text "hpc<", + ppr modl, comma, + ppr ix, + text ">"] +- ppr (Breakpoint ix vars) = ++ ppr (Breakpoint _ext ix vars) = + hcat [text "break<", + ppr ix, + text ">", +diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs +index 91b632f27e..ac5c0cd8e6 100644 +--- a/compiler/deSugar/Coverage.hs ++++ b/compiler/deSugar/Coverage.hs +@@ -366,7 +366,7 @@ addTickLHsBind _ = panic "addTickLHsBind: Impossible Match" -- due to #15884 + + + bindTick +- :: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id)) ++ :: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe CoreTickish) + bindTick density name pos fvs = do + decl_path <- getPathEntry + let +@@ -1189,7 +1189,7 @@ allocTickBox boxLabel countEntries topOnly pos m = + -- the tick application inherits the source position of its + -- expression argument to support nested box allocations + allocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars +- -> TM (Maybe (Tickish Id)) ++ -> TM (Maybe CoreTickish) + allocATickBox boxLabel countEntries topOnly pos fvs = + ifGoodTickSrcSpan pos (do + let +@@ -1203,7 +1203,7 @@ allocATickBox boxLabel countEntries topOnly pos fvs = + + + mkTickish :: BoxLabel -> Bool -> Bool -> SrcSpan -> OccEnv Id -> [String] +- -> TM (Tickish Id) ++ -> TM CoreTickish + mkTickish boxLabel countEntries topOnly pos fvs decl_path = do + + let ids = filter (not . isUnliftedType . idType) $ occEnvElts fvs +@@ -1238,7 +1238,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do + c <- liftM tickBoxCount getState + setState $ \st -> st { tickBoxCount = c + 1 + , mixEntries = me:mixEntries st } +- return $ Breakpoint c ids ++ return $ Breakpoint noExtField c ids + + SourceNotes | RealSrcSpan pos' <- pos -> + return $ SourceNote pos' cc_name +diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs +index b76c4f0592..c94595b29d 100644 +--- a/compiler/deSugar/DsUtils.hs ++++ b/compiler/deSugar/DsUtils.hs +@@ -665,7 +665,7 @@ work out well: + which is better. + -} + +-mkSelectorBinds :: [[Tickish Id]] -- ^ ticks to add, possibly ++mkSelectorBinds :: [[CoreTickish]] -- ^ ticks to add, possibly + -> LPat GhcTc -- ^ The pattern + -> CoreExpr -- ^ Expression to which the pattern is bound + -> DsM (Id,[(Id,CoreExpr)]) +@@ -890,7 +890,7 @@ the tail call property. For example, see #3403. + * * + ********************************************************************* -} + +-mkOptTickBox :: [Tickish Id] -> CoreExpr -> CoreExpr ++mkOptTickBox :: [CoreTickish] -> CoreExpr -> CoreExpr + mkOptTickBox = flip (foldr Tick) + + mkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr +diff --git a/compiler/ghci/ByteCodeAsm.hs b/compiler/ghci/ByteCodeAsm.hs +index 44876efc91..9d2aea3d4a 100644 +--- a/compiler/ghci/ByteCodeAsm.hs ++++ b/compiler/ghci/ByteCodeAsm.hs +@@ -7,10 +7,10 @@ + -- | ByteCodeLink: Bytecode assembler and linker + module ByteCodeAsm ( + assembleBCOs, assembleOneBCO, +- + bcoFreeNames, + SizedSeq, sizeSS, ssElts, +- iNTERP_STACK_CHECK_THRESH ++ iNTERP_STACK_CHECK_THRESH, ++ mkTupleInfoLit + ) where + + #include "HsVersions.h" +@@ -376,6 +376,16 @@ assembleI dflags i = case i of + -> do let ul_bco = assembleBCO dflags proto + p <- ioptr (liftM BCOPtrBCO ul_bco) + emit (push_alts pk) [Op p] ++ PUSH_ALTS_T proto tuple_info tuple_proto ++ -> do let ul_bco = assembleBCO dflags proto ++ ul_tuple_bco = assembleBCO dflags ++ tuple_proto ++ p <- ioptr (liftM BCOPtrBCO ul_bco) ++ p_tup <- ioptr (liftM BCOPtrBCO ul_tuple_bco) ++ info <- int (fromIntegral $ ++ mkTupleInfoSig tuple_info) ++ emit bci_PUSH_ALTS_T ++ [Op p, Op info, Op p_tup] + PUSH_PAD8 -> emit bci_PUSH_PAD8 [] + PUSH_PAD16 -> emit bci_PUSH_PAD16 [] + PUSH_PAD32 -> emit bci_PUSH_PAD32 [] +@@ -434,6 +444,7 @@ assembleI dflags i = case i of + ENTER -> emit bci_ENTER [] + RETURN -> emit bci_RETURN [] + RETURN_UBX rep -> emit (return_ubx rep) [] ++ RETURN_T -> emit bci_RETURN_T [] + CCALL off m_addr i -> do np <- addr m_addr + emit bci_CCALL [SmallOp off, Op np, SmallOp i] + BRK_FUN index uniq cc -> do p1 <- ptr BCOPtrBreakArray +@@ -501,6 +512,64 @@ return_ubx V16 = error "return_ubx: vector" + return_ubx V32 = error "return_ubx: vector" + return_ubx V64 = error "return_ubx: vector" + ++{- ++ Construct the tuple_info word that stg_ctoi_t and stg_ret_t use ++ to convert a tuple between the native calling convention and the ++ interpreter. ++ ++ See StgMiscClosures.cmm for more information. ++ -} ++mkTupleInfoSig :: TupleInfo -> Word32 ++mkTupleInfoSig ti@TupleInfo{..} ++ {- ++ we can only handle up to a fixed number of words on the stack, ++ because we need a stg_ctoi_tN stack frame for each size N ++ ++ If needed, you can support larger tuples by adding more in ++ StgMiscClosures.cmm and MiscClosures.h and raising this limit. ++ -} ++ | tupleNativeStackSize > 32 = ++ pprPanic "mkTupleInfoSig: tuple too big" (ppr tupleNativeStackSize) ++ {- ++ Check that we aren't using too many registers for argument passing. ++ If this panic is triggered, the calling convention uses more. ++ ++ You can raise the limits after modifying stg_ctoi_t and stg_ret_t ++ (StgMiscClosures.cmm) to save and restore the additional registers. ++ -} ++ | tupleVanillaRegs >= 64 = -- at most 6 vanilla registers ++ pprPanic "mkTupleInfoSig: too many vanilla registers" (ppr tupleVanillaRegs) ++ | tupleLongRegs >= 2 = -- at most 1 long register ++ pprPanic "mkTupleInfoSig: too many long registers" (ppr tupleLongRegs) ++ | tupleFloatRegs >= 64 = -- at most 6 float registers ++ pprPanic "mkTupleInfoSig: too many float registers" (ppr tupleFloatRegs) ++ | tupleDoubleRegs >= 64 = -- at most 6 double registers ++ pprPanic "mkTupleInfoSig: too many double registers" (ppr tupleDoubleRegs) ++ {- ++ Check that we can pack the register counts/bitmaps and stack size ++ in the information word. ++ -} ++ | tupleNativeStackSize < 16384 && ++ tupleDoubleRegs < 64 && -- 6 bit bitmap (these can be shared with float) ++ tupleFloatRegs < 64 && -- 6 bit bitmap (these can be shared with double) ++ tupleLongRegs < 4 && -- 2 bit bitmap ++ tupleVanillaRegs < 65536 && -- 4 bit count ++ -- check that there are no "holes", i.e. that R1..Rn are all in use ++ tupleVanillaRegs .&. (tupleVanillaRegs + 1) == 0 ++ = fromIntegral tupleNativeStackSize .|. ++ w (tupleLongRegs `shiftL` 14) .|. ++ w (tupleDoubleRegs `shiftL` 16) .|. ++ w (tupleFloatRegs `shiftL` 22) .|. ++ w (countTrailingZeros (1 + tupleVanillaRegs) `shiftL` 28) ++ | otherwise = pprPanic "mkTupleInfoSig: unsupported tuple shape" (ppr ti) ++ where ++ w :: Int -> Word32 ++ w = fromIntegral ++ ++mkTupleInfoLit :: DynFlags -> TupleInfo -> Literal ++mkTupleInfoLit dflags tuple_info = ++ mkLitWord dflags . fromIntegral $ mkTupleInfoSig tuple_info ++ + -- Make lists of host-sized words for literals, so that when the + -- words are placed in memory at increasing addresses, the + -- bit pattern is correct for the host's word size and endianness. +diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs +index 2b761a7186..6ededa1413 100644 +--- a/compiler/ghci/ByteCodeGen.hs ++++ b/compiler/ghci/ByteCodeGen.hs +@@ -30,12 +30,9 @@ import Id + import Var ( updateVarType ) + import ForeignCall + import HscTypes +-import CoreUtils + import CoreSyn +-import PprCore + import Literal + import PrimOp +-import CoreFVs + import Type + import RepType + import DataCon +@@ -55,6 +52,12 @@ import Bitmap + import OrdList + import Maybes + import VarEnv ++import CmmCallConv ++import CmmType ++import CmmExpr ++import CmmNode ++import CmmUtils ++import PrelInfo + + import Data.List + import Foreign +@@ -76,12 +79,16 @@ import Data.Ord + import GHC.Stack.CCS + import Data.Either ( partitionEithers ) + ++import qualified CostCentre as CC ++import StgSyn ++import StgFVs ++ + -- ----------------------------------------------------------------------------- + -- Generating byte code for a complete module + + byteCodeGen :: HscEnv + -> Module +- -> CoreProgram ++ -> [StgTopBinding] + -> [TyCon] + -> Maybe ModBreaks + -> IO CompiledByteCode +@@ -91,17 +98,22 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks + (const ()) $ do + -- Split top-level binds into strings and others. + -- See Note [generating code for top-level string literal bindings]. +- let (strings, flatBinds) = partitionEithers $ do -- list monad +- (bndr, rhs) <- flattenBinds binds +- return $ case exprIsTickedString_maybe rhs of +- Just str -> Left (bndr, str) +- _ -> Right (bndr, simpleFreeVars rhs) ++ let (strings, lifted_binds) = partitionEithers $ do -- list monad ++ bnd <- binds ++ case bnd of ++ StgTopLifted bnd -> [Right bnd] ++ StgTopStringLit b str -> [Left (b, str)] ++ flattenBind (StgNonRec b e) = [(b,e)] ++ flattenBind (StgRec bs) = bs + stringPtrs <- allocateTopStrings hsc_env strings + + us <- mkSplitUniqSupply 'y' + (BcM_State{..}, proto_bcos) <- +- runBc hsc_env us this_mod mb_modBreaks (mkVarEnv stringPtrs) $ +- mapM schemeTopBind flatBinds ++ runBc hsc_env us this_mod mb_modBreaks (mkVarEnv stringPtrs) $ do ++ prepd_binds <- mapM bcPrepBind lifted_binds ++ let flattened_binds = ++ concatMap (flattenBind . annBindingFreeVars) (reverse prepd_binds) ++ mapM schemeTopBind flattened_binds + + when (notNull ffis) + (panic "ByteCodeGen.byteCodeGen: missing final emitBc?") +@@ -155,23 +167,25 @@ literals: + -- Returns: the root BCO for this expression + coreExprToBCOs :: HscEnv + -> Module +- -> CoreExpr ++ -> Id ++ -> StgRhs + -> IO UnlinkedBCO +-coreExprToBCOs hsc_env this_mod expr ++coreExprToBCOs hsc_env this_mod bndr expr + = withTiming dflags + (text "ByteCodeGen"<+>brackets (ppr this_mod)) + (const ()) $ do +- -- create a totally bogus name for the top-level BCO; this +- -- should be harmless, since it's never used for anything +- let invented_name = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "ExprTopLevel") +- invented_id = Id.mkLocalId invented_name (panic "invented_id's type") + + -- the uniques are needed to generate fresh variables when we introduce new + -- let bindings for ticked expressions + us <- mkSplitUniqSupply 'y' + (BcM_State _dflags _us _this_mod _final_ctr mallocd _ _ _, proto_bco) +- <- runBc hsc_env us this_mod Nothing emptyVarEnv $ +- schemeTopBind (invented_id, simpleFreeVars expr) ++ <- runBc hsc_env us this_mod Nothing emptyVarEnv $ do ++ prepd_expr <- annBindingFreeVars <$> ++ bcPrepBind (StgNonRec bndr expr) ++ case prepd_expr of ++ (StgNonRec _ cg_expr) -> schemeR [] (idName bndr, cg_expr) ++ _ -> ++ panic "GHC.CoreToByteCode.coreExprToBCOs" + + when (notNull mallocd) + (panic "ByteCodeGen.coreExprToBCOs: missing final emitBc?") +@@ -181,26 +195,106 @@ coreExprToBCOs hsc_env this_mod expr + assembleOneBCO hsc_env proto_bco + where dflags = hsc_dflags hsc_env + +--- The regular freeVars function gives more information than is useful to +--- us here. We need only the free variables, not everything in an FVAnn. +--- Historical note: At one point FVAnn was more sophisticated than just +--- a set. Now it isn't. So this function is much simpler. Keeping it around +--- so that if someone changes FVAnn, they will get a nice type error right +--- here. +-simpleFreeVars :: CoreExpr -> AnnExpr Id DVarSet +-simpleFreeVars = freeVars ++{- ++ Prepare the STG for bytecode generation: ++ ++ - Ensure that all breakpoints are directly under ++ a let-binding, introducing a new binding for ++ those that aren't already. ++ ++ - Protect Not-necessarily lifted join points, see ++ Note [Not-necessarily-lifted join points] ++ ++ -} ++ ++bcPrepRHS :: StgRhs -> BcM StgRhs ++-- explicitly match all constructors so we get a warning if we miss any ++bcPrepRHS (StgRhsClosure fvs cc upd args (StgTick bp@Breakpoint{} expr)) = do ++ {- If we have a breakpoint directly under an StgRhsClosure we don't ++ need to introduce a new binding for it. ++ -} ++ expr' <- bcPrepExpr expr ++ pure (StgRhsClosure fvs cc upd args (StgTick bp expr')) ++bcPrepRHS (StgRhsClosure fvs cc upd args expr) = ++ StgRhsClosure fvs cc upd args <$> bcPrepExpr expr ++bcPrepRHS con@StgRhsCon{} = pure con ++ ++bcPrepExpr :: StgExpr -> BcM StgExpr ++-- explicitly match all constructors so we get a warning if we miss any ++bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs) ++ | isLiftedTypeKind (typeKind tick_ty) = do ++ id <- newId tick_ty ++ rhs' <- bcPrepExpr rhs ++ let expr' = StgTick bp rhs' ++ bnd = StgNonRec id (StgRhsClosure noExtFieldSilent ++ CC.dontCareCCS ++ ReEntrant ++ [] ++ expr' ++ ) ++ letExp = StgLet noExtFieldSilent bnd (StgApp id []) ++ pure letExp ++ | otherwise = do ++ id <- newId (mkVisFunTy realWorldStatePrimTy tick_ty) ++ st <- newId realWorldStatePrimTy ++ rhs' <- bcPrepExpr rhs ++ let expr' = StgTick bp rhs' ++ bnd = StgNonRec id (StgRhsClosure noExtFieldSilent ++ CC.dontCareCCS ++ ReEntrant ++ [voidArgId] ++ expr' ++ ) ++ pure $ StgLet noExtFieldSilent bnd (StgApp id [StgVarArg st]) ++bcPrepExpr (StgTick tick rhs) = ++ StgTick tick <$> bcPrepExpr rhs ++bcPrepExpr (StgLet xlet bnds expr) = ++ StgLet xlet <$> bcPrepBind bnds ++ <*> bcPrepExpr expr ++bcPrepExpr (StgLetNoEscape xlne bnds expr) = ++ StgLet xlne <$> bcPrepBind bnds ++ <*> bcPrepExpr expr ++bcPrepExpr (StgCase expr bndr alt_type alts) = ++ StgCase <$> bcPrepExpr expr ++ <*> pure bndr ++ <*> pure alt_type ++ <*> mapM bcPrepAlt alts ++bcPrepExpr lit@StgLit{} = pure lit ++-- See Note [Not-necessarily-lifted join points], step 3. ++bcPrepExpr (StgApp x []) ++ | isNNLJoinPoint x = pure $ ++ StgApp (protectNNLJoinPointId x) [StgVarArg voidPrimId] ++bcPrepExpr app@StgApp{} = pure app ++bcPrepExpr app@StgConApp{} = pure app ++bcPrepExpr app@StgOpApp{} = pure app ++bcPrepExpr StgLam{} = panic "bcPrepExpr: StgLam" ++ ++bcPrepAlt :: StgAlt -> BcM StgAlt ++bcPrepAlt (ac, bndrs, expr) = (,,) ac bndrs <$> bcPrepExpr expr ++ ++bcPrepBind :: StgBinding -> BcM StgBinding ++-- explicitly match all constructors so we get a warning if we miss any ++bcPrepBind (StgNonRec bndr rhs) = ++ let (bndr', rhs') = bcPrepSingleBind (bndr, rhs) ++ in StgNonRec bndr' <$> bcPrepRHS rhs' ++bcPrepBind (StgRec bnds) = ++ StgRec <$> mapM ((\(b,r) -> (,) b <$> bcPrepRHS r) . bcPrepSingleBind) ++ bnds ++ ++bcPrepSingleBind :: (Id, StgRhs) -> (Id, StgRhs) ++-- If necessary, modify this Id and body to protect not-necessarily-lifted join points. ++-- See Note [Not-necessarily-lifted join points], step 2. ++bcPrepSingleBind (x, StgRhsClosure ext cc upd_flag args body) ++ | isNNLJoinPoint x ++ = ( protectNNLJoinPointId x ++ , StgRhsClosure ext cc upd_flag (args ++ [voidArgId]) body) ++bcPrepSingleBind bnd = bnd + + -- ----------------------------------------------------------------------------- + -- Compilation schema for the bytecode generator + + type BCInstrList = OrdList BCInstr + +-newtype ByteOff = ByteOff Int +- deriving (Enum, Eq, Integral, Num, Ord, Real) +- +-newtype WordOff = WordOff Int +- deriving (Enum, Eq, Integral, Num, Ord, Real) +- + wordsToBytes :: DynFlags -> WordOff -> ByteOff + wordsToBytes dflags = fromIntegral . (* wORD_SIZE dflags) . fromIntegral + +@@ -230,7 +324,7 @@ ppBCEnv p + $$ nest 4 (vcat (map pp_one (sortBy cmp_snd (Map.toList p)))) + $$ text "end-env" + where +- pp_one (var, offset) = int offset <> colon <+> ppr var <+> ppr (bcIdArgRep var) ++ pp_one (var, ByteOff offset) = int offset <> colon <+> ppr var <+> ppr (bcIdArgReps var) + cmp_snd x y = compare (snd x) (snd y) + -} + +@@ -240,7 +334,7 @@ mkProtoBCO + :: DynFlags + -> name + -> BCInstrList +- -> Either [AnnAlt Id DVarSet] (AnnExpr Id DVarSet) ++ -> Either [CgStgAlt] (CgStgRhs) + -- ^ original expression; for debugging only + -> Int + -> Word16 +@@ -299,12 +393,17 @@ argBits dflags (rep : args) + | isFollowableArg rep = False : argBits dflags args + | otherwise = take (argRepSizeW dflags rep) (repeat True) ++ argBits dflags args + ++non_void :: [ArgRep] -> [ArgRep] ++non_void = filter nv ++ where nv V = False ++ nv _ = True ++ + -- ----------------------------------------------------------------------------- + -- schemeTopBind + + -- Compile code for the right-hand side of a top-level binding + +-schemeTopBind :: (Id, AnnExpr Id DVarSet) -> BcM (ProtoBCO Name) ++schemeTopBind :: (Id, CgStgRhs) -> BcM (ProtoBCO Name) + schemeTopBind (id, rhs) + | Just data_con <- isDataConWorkId_maybe id, + isNullaryRepDataCon data_con = do +@@ -321,7 +420,7 @@ schemeTopBind (id, rhs) + (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-}) + + | otherwise +- = schemeR [{- No free variables -}] (id, rhs) ++ = schemeR [{- No free variables -}] (getName id, rhs) + + + -- ----------------------------------------------------------------------------- +@@ -333,46 +432,29 @@ schemeTopBind (id, rhs) + -- removing the free variables and arguments. + -- + -- Park the resulting BCO in the monad. Also requires the +--- variable to which this value was bound, so as to give the +--- resulting BCO a name. +- ++-- name of the variable to which this value was bound, ++-- so as to give the resulting BCO a name. + schemeR :: [Id] -- Free vars of the RHS, ordered as they + -- will appear in the thunk. Empty for + -- top-level things, which have no free vars. +- -> (Id, AnnExpr Id DVarSet) ++ -> (Name, CgStgRhs) + -> BcM (ProtoBCO Name) + schemeR fvs (nm, rhs) +-{- +- | trace (showSDoc ( +- (char ' ' +- $$ (ppr.filter (not.isTyVar).dVarSetElems.fst) rhs +- $$ pprCoreExpr (deAnnotate rhs) +- $$ char ' ' +- ))) False +- = undefined +- | otherwise +--} + = schemeR_wrk fvs nm rhs (collect rhs) + + -- If an expression is a lambda (after apply bcView), return the + -- list of arguments to the lambda (in R-to-L order) and the + -- underlying expression +-collect :: AnnExpr Id DVarSet -> ([Var], AnnExpr' Id DVarSet) +-collect (_, e) = go [] e +- where +- go xs e | Just e' <- bcView e = go xs e' +- go xs (AnnLam x (_,e)) +- | typePrimRep (idType x) `lengthExceeds` 1 +- = multiValException +- | otherwise +- = go (x:xs) e +- go xs not_lambda = (reverse xs, not_lambda) ++ ++collect :: CgStgRhs -> ([Var], CgStgExpr) ++collect (StgRhsClosure _ _ _ args body) = (args, body) ++collect (StgRhsCon _cc dc args) = ([], StgConApp dc args []) + + schemeR_wrk + :: [Id] +- -> Id +- -> AnnExpr Id DVarSet -- expression e, for debugging only +- -> ([Var], AnnExpr' Var DVarSet) -- result of collect on e ++ -> Name ++ -> CgStgRhs -- expression e, for debugging only ++ -> ([Var], CgStgExpr) -- result of collect on e + -> BcM (ProtoBCO Name) + schemeR_wrk fvs nm original_body (args, body) + = do +@@ -400,17 +482,16 @@ schemeR_wrk fvs nm original_body (args, body) + arity bitmap_size bitmap False{-not alts-}) + + -- introduce break instructions for ticked expressions +-schemeER_wrk :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList +-schemeER_wrk d p rhs +- | AnnTick (Breakpoint tick_no fvs) (_annot, newRhs) <- rhs +- = do code <- schemeE d 0 p newRhs ++schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList ++schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs) rhs) ++ = do code <- schemeE d 0 p rhs + cc_arr <- getCCArray + this_mod <- moduleName <$> getCurrentModule + dflags <- getDynFlags + let idOffSets = getVarOffSets dflags d p fvs + let breakInfo = CgBreakInfo + { cgb_vars = idOffSets +- , cgb_resty = exprType (deAnnotate' newRhs) ++ , cgb_resty = tick_ty + } + newBreakInfo tick_no breakInfo + dflags <- getDynFlags +@@ -418,7 +499,7 @@ schemeER_wrk d p rhs + | otherwise = toRemotePtr nullPtr + let breakInstr = BRK_FUN (fromIntegral tick_no) (getUnique this_mod) cc + return $ breakInstr `consOL` code +- | otherwise = schemeE d 0 p rhs ++schemeER_wrk d p rhs = schemeE d 0 p rhs + + getVarOffSets :: DynFlags -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, Word16)] + getVarOffSets dflags depth env = map getOffSet +@@ -450,7 +531,7 @@ trunc16B = truncIntegral16 + trunc16W :: WordOff -> Word16 + trunc16W = truncIntegral16 + +-fvsToEnv :: BCEnv -> DVarSet -> [Id] ++fvsToEnv :: BCEnv -> CgStgRhs -> [Id] + -- Takes the free variables of a right-hand side, and + -- delivers an ordered list of the local variables that will + -- be captured in the thunk for the RHS +@@ -459,88 +540,126 @@ fvsToEnv :: BCEnv -> DVarSet -> [Id] + -- + -- The code that constructs the thunk, and the code that executes + -- it, have to agree about this layout +-fvsToEnv p fvs = [v | v <- dVarSetElems fvs, +- isId v, -- Could be a type variable +- v `Map.member` p] ++ ++fvsToEnv p (StgRhsClosure fvs _ _ _ _) = ++ [v | v <- dVarSetElems fvs, ++ v `Map.member` p] ++fvsToEnv _ _ = [] + + -- ----------------------------------------------------------------------------- + -- schemeE + ++-- Returning an unlifted value. ++-- Heave it on the stack, SLIDE, and RETURN. + returnUnboxedAtom + :: StackDepth + -> Sequel + -> BCEnv +- -> AnnExpr' Id DVarSet +- -> ArgRep ++ -> StgArg + -> BcM BCInstrList +--- Returning an unlifted value. +--- Heave it on the stack, SLIDE, and RETURN. +-returnUnboxedAtom d s p e e_rep = do +- dflags <- getDynFlags ++returnUnboxedAtom d s p e = do ++ let reps = case e of ++ StgLitArg lit -> typePrimRepArgs (literalType lit) ++ StgVarArg i -> bcIdPrimReps i + (push, szb) <- pushAtom d p e +- return (push -- value onto stack +- `appOL` mkSlideB dflags szb (d - s) -- clear to sequel +- `snocOL` RETURN_UBX e_rep) -- go ++ ret <- returnUnboxedReps d s szb reps ++ return (push `appOL` ret) ++ ++-- return an unboxed value from the top of the stack ++returnUnboxedReps ++ :: StackDepth ++ -> Sequel ++ -> ByteOff -- size of the thing we're returning ++ -> [PrimRep] -- representations ++ -> BcM BCInstrList ++returnUnboxedReps d s szb reps = do ++ dflags <- getDynFlags ++ let non_void VoidRep = False ++ non_void _ = True ++ ret <- case filter non_void reps of ++ -- use RETURN_UBX for unary representations ++ [] -> return (unitOL $ RETURN_UBX V) ++ [rep] -> return (unitOL $ RETURN_UBX (toArgRep rep)) ++ -- otherwise use RETURN_T with a tuple descriptor ++ nv_reps -> do ++ let (tuple_info, args_offsets) = layoutTuple dflags 0 (primRepCmmType dflags) nv_reps ++ args_ptrs = map (\(rep, off) -> (isFollowableArg (toArgRep rep), off)) args_offsets ++ tuple_bco <- emitBc (tupleBCO dflags tuple_info args_ptrs) ++ return $ PUSH_UBX (mkTupleInfoLit dflags tuple_info) 1 `consOL` ++ PUSH_BCO tuple_bco `consOL` ++ unitOL RETURN_T ++ return ( mkSlideB dflags szb (d - s) -- clear to sequel ++ `appOL` ret) -- go ++ ++-- construct and return an unboxed tuple ++returnUnboxedTuple ++ :: StackDepth ++ -> Sequel ++ -> BCEnv ++ -> [StgArg] ++ -> BcM BCInstrList ++returnUnboxedTuple d s p es = do ++ dflags <- getDynFlags ++ let arg_ty e = primRepCmmType dflags (atomPrimRep e) ++ (tuple_info, tuple_components) = layoutTuple dflags d arg_ty es ++ go _ pushes [] = return (reverse pushes) ++ go !dd pushes ((a, off):cs) = do (push, szb) <- pushAtom dd p a ++ MASSERT(off == dd + szb) ++ go (dd + szb) (push:pushes) cs ++ pushes <- go d [] tuple_components ++ ret <- returnUnboxedReps d ++ s ++ (wordsToBytes dflags $ tupleSize tuple_info) ++ (map atomPrimRep es) ++ return (mconcat pushes `appOL` ret) + + -- Compile code to apply the given expression to the remaining args + -- on the stack, returning a HNF. + schemeE +- :: StackDepth -> Sequel -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList +-schemeE d s p e +- | Just e' <- bcView e +- = schemeE d s p e' ++ :: StackDepth -> Sequel -> BCEnv -> CgStgExpr -> BcM BCInstrList ++schemeE d s p (StgLit lit) = returnUnboxedAtom d s p (StgLitArg lit) ++schemeE d s p (StgApp x []) ++ | isUnliftedType (idType x) = returnUnboxedAtom d s p (StgVarArg x) ++schemeE _ _ _ (StgLam {}) = panic "schemeE: StgLam" + + -- Delegate tail-calls to schemeT. +-schemeE d s p e@(AnnApp _ _) = schemeT d s p e +- +-schemeE d s p e@(AnnLit lit) = returnUnboxedAtom d s p e (typeArgRep (literalType lit)) +-schemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e V +- +-schemeE d s p e@(AnnVar v) +- -- See Note [Not-necessarily-lifted join points], step 3. +- | isNNLJoinPoint v = doTailCall d s p (protectNNLJoinPointId v) [AnnVar voidPrimId] +- | isUnliftedType (idType v) = returnUnboxedAtom d s p e (bcIdArgRep v) +- | otherwise = schemeT d s p e +- +-schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body)) +- | (AnnVar v, args_r_to_l) <- splitApp rhs, +- Just data_con <- isDataConWorkId_maybe v, +- dataConRepArity data_con == length args_r_to_l ++schemeE d s p e@(StgApp {}) = schemeT d s p e ++schemeE d s p e@(StgConApp {}) = schemeT d s p e ++schemeE d s p e@(StgOpApp {}) = schemeT d s p e ++schemeE d s p (StgLetNoEscape xlet bnd body) ++ = schemeE d s p (StgLet xlet bnd body) ++schemeE d s p (StgLet _xlet (StgNonRec x (StgRhsCon _cc data_con args)) body) + = do -- Special case for a non-recursive let whose RHS is a + -- saturated constructor application. + -- Just allocate the constructor and carry on +- alloc_code <- mkConAppCode d s p data_con args_r_to_l ++ alloc_code <- mkConAppCode d s p data_con args + dflags <- getDynFlags + let !d2 = d + wordSize dflags + body_code <- schemeE d2 s (Map.insert x d2 p) body + return (alloc_code `appOL` body_code) +- + -- General case for let. Generates correct, if inefficient, code in + -- all situations. +-schemeE d s p (AnnLet binds (_,body)) = do ++schemeE d s p (StgLet _ext binds body) = do + dflags <- getDynFlags +- let (xs,rhss) = case binds of AnnNonRec x rhs -> ([x],[rhs]) +- AnnRec xs_n_rhss -> unzip xs_n_rhss ++ let (xs,rhss) = case binds of StgNonRec x rhs -> ([x],[rhs]) ++ StgRec xs_n_rhss -> unzip xs_n_rhss + n_binds = genericLength xs + +- fvss = map (fvsToEnv p' . fst) rhss +- +- -- See Note [Not-necessarily-lifted join points], step 2. +- (xs',rhss') = zipWithAndUnzip protectNNLJoinPointBind xs rhss ++ fvss = map (fvsToEnv p') rhss + + -- Sizes of free vars + size_w = trunc16W . idSizeW dflags + sizes = map (\rhs_fvs -> sum (map size_w rhs_fvs)) fvss + + -- the arity of each rhs +- arities = map (genericLength . fst . collect) rhss' ++ arities = map (genericLength . fst . collect) rhss + + -- This p', d' defn is safe because all the items being pushed + -- are ptrs, so all have size 1 word. d' and p' reflect the stack + -- after the closures have been allocated in the heap (but not + -- filled in), and pointers to them parked on the stack. + offsets = mkStackOffsets d (genericReplicate n_binds (wordSize dflags)) +- p' = Map.insertList (zipE xs' offsets) p ++ p' = Map.insertList (zipE xs offsets) p + d' = d + wordsToBytes dflags n_binds + zipE = zipEqual "schemeE" + +@@ -559,7 +678,7 @@ schemeE d s p (AnnLet binds (_,body)) = do + mkap | arity == 0 = MKAP + | otherwise = MKPAP + build_thunk dd (fv:fvs) size bco off arity = do +- (push_code, pushed_szb) <- pushAtom dd p' (AnnVar fv) ++ (push_code, pushed_szb) <- pushAtom dd p' (StgVarArg fv) + more_push_code <- + build_thunk (dd + pushed_szb) fvs size bco off arity + return (push_code `appOL` more_push_code) +@@ -571,109 +690,35 @@ schemeE d s p (AnnLet binds (_,body)) = do + mkAlloc sz arity = ALLOC_PAP arity sz + + is_tick = case binds of +- AnnNonRec id _ -> occNameFS (getOccName id) == tickFS ++ StgNonRec id _ -> occNameFS (getOccName id) == tickFS + _other -> False + + compile_bind d' fvs x rhs size arity off = do +- bco <- schemeR fvs (x,rhs) ++ bco <- schemeR fvs (getName x,rhs) + build_thunk d' fvs size bco off arity + + compile_binds = + [ compile_bind d' fvs x rhs size arity (trunc16W n) + | (fvs, x, rhs, size, arity, n) <- +- zip6 fvss xs' rhss' sizes arities [n_binds, n_binds-1 .. 1] ++ zip6 fvss xs rhss sizes arities [n_binds, n_binds-1 .. 1] + ] + body_code <- schemeE d' s p' body + thunk_codes <- sequence compile_binds + return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code) + +--- Introduce a let binding for a ticked case expression. This rule +--- *should* only fire when the expression was not already let-bound +--- (the code gen for let bindings should take care of that). Todo: we +--- call exprFreeVars on a deAnnotated expression, this may not be the +--- best way to calculate the free vars but it seemed like the least +--- intrusive thing to do +-schemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs) +- | isLiftedTypeKind (typeKind ty) +- = do id <- newId ty +- -- Todo: is emptyVarSet correct on the next line? +- let letExp = AnnLet (AnnNonRec id (fvs, exp)) (emptyDVarSet, AnnVar id) +- schemeE d s p letExp +- +- | otherwise +- = do -- If the result type is not definitely lifted, then we must generate +- -- let f = \s . tick e +- -- in f realWorld# +- -- When we stop at the breakpoint, _result will have an unlifted +- -- type and hence won't be bound in the environment, but the +- -- breakpoint will otherwise work fine. +- -- +- -- NB (#12007) this /also/ applies for if (ty :: TYPE r), where +- -- r :: RuntimeRep is a variable. This can happen in the +- -- continuations for a pattern-synonym matcher +- -- match = /\(r::RuntimeRep) /\(a::TYPE r). +- -- \(k :: Int -> a) \(v::T). +- -- case v of MkV n -> k n +- -- Here (k n) :: a :: Type r, so we don't know if it's lifted +- -- or not; but that should be fine provided we add that void arg. +- +- id <- newId (mkVisFunTy realWorldStatePrimTy ty) +- st <- newId realWorldStatePrimTy +- let letExp = AnnLet (AnnNonRec id (fvs, AnnLam st (emptyDVarSet, exp))) +- (emptyDVarSet, (AnnApp (emptyDVarSet, AnnVar id) +- (emptyDVarSet, AnnVar realWorldPrimId))) +- schemeE d s p letExp +- +- where +- exp' = deAnnotate' exp +- fvs = exprFreeVarsDSet exp' +- ty = exprType exp' ++schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs) ++ = panic ("schemeE: Breakpoint without let binding: " ++ ++ show bp_id ++ ++ " forgot to run bcPrep?") + + -- ignore other kinds of tick +-schemeE d s p (AnnTick _ (_, rhs)) = schemeE d s p rhs +- +-schemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut +- -- no alts: scrut is guaranteed to diverge +- +-schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) +- | isUnboxedTupleCon dc -- handles pairs with one void argument (e.g. state token) +- -- Convert +- -- case .... of x { (# V'd-thing, a #) -> ... } +- -- to +- -- case .... of a { DEFAULT -> ... } +- -- because the return convention for both are identical. +- -- +- -- Note that it does not matter losing the void-rep thing from the +- -- envt (it won't be bound now) because we never look such things up. +- , Just res <- case (typePrimRep (idType bind1), typePrimRep (idType bind2)) of +- ([], [_]) +- -> Just $ doCase d s p scrut bind2 [(DEFAULT, [], rhs)] (Just bndr) +- ([_], []) +- -> Just $ doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr) +- _ -> Nothing +- = res +- +-schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)]) +- | isUnboxedTupleCon dc +- , typePrimRep (idType bndr) `lengthAtMost` 1 -- handles unit tuples +- = doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr) +- +-schemeE d s p (AnnCase scrut bndr _ alt@[(DEFAULT, [], _)]) +- | isUnboxedTupleType (idType bndr) +- , Just ty <- case typePrimRep (idType bndr) of +- [_] -> Just (unwrapType (idType bndr)) +- [] -> Just voidPrimTy +- _ -> Nothing +- -- handles any pattern with a single non-void binder; in particular I/O +- -- monad returns (# RealWorld#, a #) +- = doCase d s p scrut (bndr `setIdType` ty) alt (Just bndr) +- +-schemeE d s p (AnnCase scrut bndr _ alts) +- = doCase d s p scrut bndr alts Nothing{-not an unboxed tuple-} +- +-schemeE _ _ _ expr +- = pprPanic "ByteCodeGen.schemeE: unhandled case" +- (pprCoreExpr (deAnnotate' expr)) ++schemeE d s p (StgTick _ rhs) = schemeE d s p rhs ++ ++-- no alts: scrut is guaranteed to diverge ++schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut ++ ++schemeE d s p (StgCase scrut bndr _ alts) ++ = doCase d s p scrut bndr alts + + -- Is this Id a not-necessarily-lifted join point? + -- See Note [Not-necessarily-lifted join points], step 1 +@@ -681,16 +726,6 @@ isNNLJoinPoint :: Id -> Bool + isNNLJoinPoint x = isJoinId x && + Just True /= isLiftedType_maybe (idType x) + +--- If necessary, modify this Id and body to protect not-necessarily-lifted join points. +--- See Note [Not-necessarily-lifted join points], step 2. +-protectNNLJoinPointBind :: Id -> AnnExpr Id DVarSet -> (Id, AnnExpr Id DVarSet) +-protectNNLJoinPointBind x rhs@(fvs, _) +- | isNNLJoinPoint x +- = (protectNNLJoinPointId x, (fvs, AnnLam voidArgId rhs)) +- +- | otherwise +- = (x, rhs) +- + -- Update an Id's type to take a Void# argument. + -- Precondition: the Id is a not-necessarily-lifted join point. + -- See Note [Not-necessarily-lifted join points] +@@ -778,10 +813,8 @@ Right Fix is to take advantage of join points as goto-labels. + -- + -- 1. The fn denotes a ccall. Defer to generateCCall. + -- +--- 2. (Another nasty hack). Spot (# a::V, b #) and treat +--- it simply as b -- since the representations are identical +--- (the V takes up zero stack space). Also, spot +--- (# b #) and treat it as b. ++-- 2. An unboxed tuple: push the components on the top of ++-- the stack and return. + -- + -- 3. Application of a constructor, by defn saturated. + -- Split the args into ptrs and non-ptrs, and push the nonptrs, +@@ -793,57 +826,45 @@ Right Fix is to take advantage of join points as goto-labels. + schemeT :: StackDepth -- Stack depth + -> Sequel -- Sequel depth + -> BCEnv -- stack env +- -> AnnExpr' Id DVarSet ++ -> CgStgExpr + -> BcM BCInstrList + +-schemeT d s p app +- + -- Case 0 ++schemeT d s p app + | Just (arg, constr_names) <- maybe_is_tagToEnum_call app + = implement_tagToId d s p arg constr_names + + -- Case 1 +- | Just (CCall ccall_spec) <- isFCallId_maybe fn ++schemeT d s p (StgOpApp (StgFCallOp (CCall ccall_spec) _ty) args result_ty) + = if isSupportedCConv ccall_spec +- then generateCCall d s p ccall_spec fn args_r_to_l ++ then generateCCall d s p ccall_spec result_ty (reverse args) + else unsupportedCConvException + ++schemeT d s p (StgOpApp (StgPrimOp op) args _ty) ++ = doTailCall d s p (primOpId op) (reverse args) ++ ++schemeT _d _s _p (StgOpApp (StgPrimCallOp {}) _args _ty) ++ = unsupportedCConvException + +- -- Case 2: Constructor application +- | Just con <- maybe_saturated_dcon +- , isUnboxedTupleCon con +- = case args_r_to_l of +- [arg1,arg2] | isVAtom arg1 -> +- unboxedTupleReturn d s p arg2 +- [arg1,arg2] | isVAtom arg2 -> +- unboxedTupleReturn d s p arg1 +- _other -> multiValException ++ -- Case 2: Unboxed tuple ++schemeT d s p (StgConApp con args _tys) ++ | isUnboxedTupleCon con || isUnboxedSumCon con ++ = returnUnboxedTuple d s p args + + -- Case 3: Ordinary data constructor +- | Just con <- maybe_saturated_dcon +- = do alloc_con <- mkConAppCode d s p con args_r_to_l ++ | otherwise ++ = do alloc_con <- mkConAppCode d s p con args + dflags <- getDynFlags + return (alloc_con `appOL` + mkSlideW 1 (bytesToWords dflags $ d - s) `snocOL` + ENTER) + + -- Case 4: Tail call of function +- | otherwise +- = doTailCall d s p fn args_r_to_l +- +- where +- -- Extract the args (R->L) and fn +- -- The function will necessarily be a variable, +- -- because we are compiling a tail call +- (AnnVar fn, args_r_to_l) = splitApp app +- +- -- Only consider this to be a constructor application iff it is +- -- saturated. Otherwise, we'll call the constructor wrapper. +- n_args = length args_r_to_l +- maybe_saturated_dcon +- = case isDataConWorkId_maybe fn of +- Just con | dataConRepArity con == n_args -> Just con +- _ -> Nothing ++schemeT d s p (StgApp fn args) ++ = doTailCall d s p fn (reverse args) ++ ++schemeT _ _ _ e = pprPanic "GHC.CoreToByteCode.schemeT" ++ (pprStgExpr e) + + -- ----------------------------------------------------------------------------- + -- Generate code to build a constructor application, +@@ -854,25 +875,16 @@ mkConAppCode + -> Sequel + -> BCEnv + -> DataCon -- The data constructor +- -> [AnnExpr' Id DVarSet] -- Args, in *reverse* order ++ -> [StgArg] -- Args, in *reverse* order + -> BcM BCInstrList +-mkConAppCode _ _ _ con [] -- Nullary constructor +- = ASSERT( isNullaryRepDataCon con ) +- return (unitOL (PUSH_G (getName (dataConWorkId con)))) +- -- Instead of doing a PACK, which would allocate a fresh +- -- copy of this constructor, use the single shared version. +- +-mkConAppCode orig_d _ p con args_r_to_l = +- ASSERT( args_r_to_l `lengthIs` dataConRepArity con ) app_code ++mkConAppCode orig_d _ p con args = app_code + where + app_code = do + dflags <- getDynFlags + +- -- The args are initially in reverse order, but mkVirtHeapOffsets +- -- expects them to be left-to-right. + let non_voids = + [ NonVoid (prim_rep, arg) +- | arg <- reverse args_r_to_l ++ | arg <- args + , let prim_rep = atomPrimRep arg + , not (isVoidRep prim_rep) + ] +@@ -892,18 +904,6 @@ mkConAppCode orig_d _ p con args_r_to_l = + -- Push on the stack in the reverse order. + do_pushery orig_d (reverse args_offsets) + +- +--- ----------------------------------------------------------------------------- +--- Returning an unboxed tuple with one non-void component (the only +--- case we can handle). +--- +--- Remember, we don't want to *evaluate* the component that is being +--- returned, even if it is a pointed type. We always just return. +- +-unboxedTupleReturn +- :: StackDepth -> Sequel -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList +-unboxedTupleReturn d s p arg = returnUnboxedAtom d s p arg (atomRep arg) +- + -- ----------------------------------------------------------------------------- + -- Generate code for a tail-call + +@@ -912,13 +912,13 @@ doTailCall + -> Sequel + -> BCEnv + -> Id +- -> [AnnExpr' Id DVarSet] ++ -> [StgArg] + -> BcM BCInstrList + doTailCall init_d s p fn args = do_pushes init_d args (map atomRep args) + where + do_pushes !d [] reps = do + ASSERT( null reps ) return () +- (push_fn, sz) <- pushAtom d p (AnnVar fn) ++ (push_fn, sz) <- pushAtom d p (StgVarArg fn) + dflags <- getDynFlags + ASSERT( sz == wordSize dflags ) return () + let slide = mkSlideB dflags (d - init_d + wordSize dflags) (init_d - s) +@@ -972,19 +972,26 @@ doCase + :: StackDepth + -> Sequel + -> BCEnv +- -> AnnExpr Id DVarSet ++ -> CgStgExpr + -> Id +- -> [AnnAlt Id DVarSet] +- -> Maybe Id -- Just x <=> is an unboxed tuple case with scrut binder, +- -- don't enter the result ++ -> [CgStgAlt] + -> BcM BCInstrList +-doCase d s p (_,scrut) bndr alts is_unboxed_tuple +- | typePrimRep (idType bndr) `lengthExceeds` 1 +- = multiValException +- | otherwise ++doCase d s p scrut bndr alts + = do + dflags <- getDynFlags + let ++ ++ -- Are we dealing with an unboxed tuple with a tuple return frame? ++ -- ++ -- 'Simple' tuples with at most one non-void component, ++ -- like (# Word# #) or (# Int#, State# RealWorld# #) do not have a ++ -- tuple return frame ++ ubx_tuple_frame = ++ (isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty) && ++ length non_void_arg_reps > 1 ++ ++ non_void_arg_reps = non_void (typeArgReps bndr_ty) ++ + profiling + | gopt Opt_ExternalInterpreter dflags = gopt Opt_SccProfilingOn dflags + | otherwise = rtsIsProfiled +@@ -994,53 +1001,84 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple + -- When an alt is entered, it assumes the returned value is + -- on top of the itbl. + ret_frame_size_b :: StackDepth +- ret_frame_size_b = 2 * wordSize dflags ++ ret_frame_size_b | ubx_tuple_frame = ++ (if profiling then 5 else 4) * wordSize dflags ++ | otherwise = 2 * wordSize dflags + +- -- The extra frame we push to save/restor the CCCS when profiling +- save_ccs_size_b | profiling = 2 * wordSize dflags ++ -- The stack space used to save/restore the CCCS when profiling ++ save_ccs_size_b | profiling && ++ not ubx_tuple_frame = 2 * wordSize dflags + | otherwise = 0 + + -- An unlifted value gets an extra info table pushed on top + -- when it is returned. + unlifted_itbl_size_b :: StackDepth +- unlifted_itbl_size_b | isAlgCase = 0 +- | otherwise = wordSize dflags ++ unlifted_itbl_size_b | isAlgCase = 0 ++ | ubx_tuple_frame = 3 * wordSize dflags ++ | otherwise = wordSize dflags ++ ++ (bndr_size, tuple_info, args_offsets) ++ | ubx_tuple_frame = ++ let bndr_ty = primRepCmmType dflags ++ bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) ++ (tuple_info, args_offsets) = ++ layoutTuple dflags 0 bndr_ty bndr_reps ++ in ( wordsToBytes dflags (tupleSize tuple_info) ++ , tuple_info ++ , args_offsets ++ ) ++ | otherwise = ( wordsToBytes dflags (idSizeW dflags bndr) ++ , voidTupleInfo ++ , [] ++ ) + + -- depth of stack after the return value has been pushed + d_bndr = +- d + ret_frame_size_b + wordsToBytes dflags (idSizeW dflags bndr) ++ d + ret_frame_size_b + bndr_size + + -- depth of stack after the extra info table for an unboxed return + -- has been pushed, if any. This is the stack depth at the + -- continuation. +- d_alts = d_bndr + unlifted_itbl_size_b ++ d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b + + -- Env in which to compile the alts, not including + -- any vars bound by the alts themselves +- p_alts0 = Map.insert bndr d_bndr p +- +- p_alts = case is_unboxed_tuple of +- Just ubx_bndr -> Map.insert ubx_bndr d_bndr p_alts0 +- Nothing -> p_alts0 ++ p_alts = Map.insert bndr d_bndr p + + bndr_ty = idType bndr +- isAlgCase = not (isUnliftedType bndr_ty) && isNothing is_unboxed_tuple ++ isAlgCase = not (isUnliftedType bndr_ty) + + -- given an alt, return a discr and code for it. +- codeAlt (DEFAULT, _, (_,rhs)) ++ codeAlt (DEFAULT, _, rhs) + = do rhs_code <- schemeE d_alts s p_alts rhs + return (NoDiscr, rhs_code) + +- codeAlt alt@(_, bndrs, (_,rhs)) ++ codeAlt alt@(_, bndrs, rhs) + -- primitive or nullary constructor alt: no need to UNPACK + | null real_bndrs = do + rhs_code <- schemeE d_alts s p_alts rhs + return (my_discr alt, rhs_code) +- -- If an alt attempts to match on an unboxed tuple or sum, we must +- -- bail out, as the bytecode compiler can't handle them. +- -- (See #14608.) +- | any (\bndr -> typePrimRep (idType bndr) `lengthExceeds` 1) bndrs +- = multiValException ++ | isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty = ++ let bndr_ty = primRepCmmType dflags . bcIdPrimRep ++ tuple_start = d_bndr ++ (tuple_info, args_offsets) = ++ layoutTuple dflags ++ 0 ++ bndr_ty ++ bndrs ++ ++ stack_bot = d_alts ++ ++ p' = Map.insertList ++ [ (arg, tuple_start - ++ wordsToBytes dflags (tupleSize tuple_info) + ++ offset) ++ | (arg, offset) <- args_offsets ++ , not (isVoidRep $ bcIdPrimRep arg)] ++ p_alts ++ in do ++ rhs_code <- schemeE stack_bot s p' rhs ++ return (NoDiscr, rhs_code) + -- algebraic alt with some binders + | otherwise = + let (tot_wds, _ptrs_wds, args_offsets) = +@@ -1068,16 +1106,16 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple + my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} + my_discr (DataAlt dc, _, _) + | isUnboxedTupleCon dc || isUnboxedSumCon dc +- = multiValException ++ = NoDiscr + | otherwise + = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG)) + my_discr (LitAlt l, _, _) +- = case l of LitNumber LitNumInt i _ -> DiscrI (fromInteger i) +- LitNumber LitNumWord w _ -> DiscrW (fromInteger w) ++ = case l of LitNumber LitNumInt i _ -> DiscrI (fromInteger i) ++ LitNumber LitNumWord w _ -> DiscrW (fromInteger w) + LitFloat r -> DiscrF (fromRational r) + LitDouble r -> DiscrD (fromRational r) + LitChar i -> DiscrI (ord i) +- _ -> pprPanic "schemeE(AnnCase).my_discr" (ppr l) ++ _ -> pprPanic "schemeE(StgCase).my_discr" (ppr l) + + maybe_ncons + | not isAlgCase = Nothing +@@ -1100,20 +1138,36 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple + -- really want a bitmap up to depth (d-s). This affects compilation of + -- case-of-case expressions, which is the only time we can be compiling a + -- case expression with s /= 0. +- bitmap_size = trunc16W $ bytesToWords dflags (d - s) ++ ++ -- unboxed tuples get two more words, the second is a pointer (tuple_bco) ++ (extra_pointers, extra_slots) ++ | ubx_tuple_frame && profiling = ([1], 3) -- tuple_info, tuple_BCO, CCCS ++ | ubx_tuple_frame = ([1], 2) -- tuple_info, tuple_BCO ++ | otherwise = ([], 0) ++ ++ bitmap_size = trunc16W $ fromIntegral extra_slots + ++ bytesToWords dflags (d - s) ++ + bitmap_size' :: Int + bitmap_size' = fromIntegral bitmap_size +- bitmap = intsToReverseBitmap dflags bitmap_size'{-size-} +- (sort (filter (< bitmap_size') rel_slots)) ++ ++ ++ pointers = ++ extra_pointers ++ ++ sort (filter (< bitmap_size') (map (+extra_slots) rel_slots)) + where + binds = Map.toList p + -- NB: unboxed tuple cases bind the scrut binder to the same offset + -- as one of the alt binders, so we have to remove any duplicates here: +- rel_slots = nub $ map fromIntegral $ concat (map spread binds) +- spread (id, offset) | isFollowableArg (bcIdArgRep id) = [ rel_offset ] ++ rel_slots = nub $ map fromIntegral $ concatMap spread binds ++ spread (id, offset) | isUnboxedTupleType (idType id) || ++ isUnboxedSumType (idType id) = [] ++ | isFollowableArg (bcIdArgRep id) = [ rel_offset ] + | otherwise = [] + where rel_offset = trunc16W $ bytesToWords dflags (d - offset) + ++ bitmap = intsToReverseBitmap dflags bitmap_size'{-size-} pointers ++ + alt_stuff <- mapM codeAlt alts + alt_final <- mkMultiBranch maybe_ncons alt_stuff + +@@ -1121,18 +1175,118 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple + alt_bco_name = getName bndr + alt_bco = mkProtoBCO dflags alt_bco_name alt_final (Left alts) + 0{-no arity-} bitmap_size bitmap True{-is alts-} +--- trace ("case: bndr = " ++ showSDocDebug (ppr bndr) ++ "\ndepth = " ++ show d ++ "\nenv = \n" ++ showSDocDebug (ppBCEnv p) ++ +--- "\n bitmap = " ++ show bitmap) $ do +- + scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b) + (d + ret_frame_size_b + save_ccs_size_b) + p scrut + alt_bco' <- emitBc alt_bco +- let push_alts +- | isAlgCase = PUSH_ALTS alt_bco' +- | otherwise = PUSH_ALTS_UNLIFTED alt_bco' (typeArgRep bndr_ty) +- return (push_alts `consOL` scrut_code) ++ if ubx_tuple_frame ++ then do ++ let args_ptrs = ++ map (\(rep, off) -> (isFollowableArg (toArgRep rep), off)) ++ args_offsets ++ tuple_bco <- emitBc (tupleBCO dflags tuple_info args_ptrs) ++ return (PUSH_ALTS_T alt_bco' tuple_info tuple_bco ++ `consOL` scrut_code) ++ else let push_alts ++ | isAlgCase ++ = PUSH_ALTS alt_bco' ++ | otherwise ++ = let unlifted_rep = ++ case non_void_arg_reps of ++ [] -> V ++ [rep] -> rep ++ _ -> panic "schemeE(StgCase).push_alts" ++ in PUSH_ALTS_UNLIFTED alt_bco' unlifted_rep ++ in return (push_alts `consOL` scrut_code) ++ ++ ++-- ----------------------------------------------------------------------------- ++-- Deal with tuples ++ ++-- The native calling convention uses registers for tuples, but in the ++-- bytecode interpreter, all values live on the stack. ++ ++layoutTuple :: DynFlags ++ -> ByteOff ++ -> (a -> CmmType) ++ -> [a] ++ -> ( TupleInfo ++ , [(a, ByteOff)] -- argument, offset on stack ++ ) ++layoutTuple dflags start_off arg_ty reps = ++ let (orig_stk_bytes, pos) = assignArgumentsPos dflags ++ 0 ++ NativeReturn ++ arg_ty ++ reps ++ ++ -- keep the stack parameters in the same place ++ orig_stk_params = [(x, fromIntegral off) | (x, StackParam off) <- pos] ++ ++ -- sort the register parameters by register and add them to the stack ++ (regs, reg_params) ++ = unzip $ sortBy (comparing fst) ++ [(reg, x) | (x, RegisterParam reg) <- pos] ++ ++ (new_stk_bytes, new_stk_params) = assignStack dflags ++ orig_stk_bytes ++ arg_ty ++ reg_params ++ ++ -- make live register bitmaps ++ bmp_reg r ~(v, f, d, l) ++ = case r of VanillaReg n _ -> (a v n, f, d, l ) ++ FloatReg n -> (v, a f n, d, l ) ++ DoubleReg n -> (v, f, a d n, l ) ++ LongReg n -> (v, f, d, a l n) ++ _ -> ++ pprPanic "CoreToByteCode.layoutTuple unsupported register type" ++ (ppr r) ++ where a bmp n = bmp .|. (1 `shiftL` (n-1)) ++ ++ (vanilla_regs, float_regs, double_regs, long_regs) ++ = foldr bmp_reg (0, 0, 0, 0) regs ++ ++ get_byte_off (x, StackParam y) = (x, fromIntegral y) ++ get_byte_off _ = ++ panic "CoreToByteCode.layoutTuple get_byte_off" ++ ++ in ( TupleInfo ++ { tupleSize = bytesToWords dflags (ByteOff new_stk_bytes) ++ , tupleVanillaRegs = vanilla_regs ++ , tupleLongRegs = long_regs ++ , tupleFloatRegs = float_regs ++ , tupleDoubleRegs = double_regs ++ , tupleNativeStackSize = bytesToWords dflags ++ (ByteOff orig_stk_bytes) ++ } ++ , sortBy (comparing snd) $ ++ map (\(x, o) -> (x, o + start_off)) ++ (orig_stk_params ++ map get_byte_off new_stk_params) ++ ) ++ ++tupleBCO :: DynFlags -> TupleInfo -> [(Bool, ByteOff)] -> [FFIInfo] -> ProtoBCO Name ++tupleBCO dflags info pointers = ++ mkProtoBCO dflags invented_name body_code (Left []) ++ 0{-no arity-} bitmap_size bitmap False{-is alts-} + ++ where ++ {- ++ The tuple BCO is never referred to by name, so we can get away ++ with using a fake name here. We will need to change this if we want ++ to save some memory by sharing the BCO between places that have ++ the same tuple shape ++ -} ++ invented_name = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "tuple") ++ ++ -- the first word in the frame is the tuple_info word, ++ -- which is not a pointer ++ bitmap_size = trunc16W $ 1 + tupleSize info ++ bitmap = intsToReverseBitmap dflags (fromIntegral bitmap_size) $ ++ map ((+1) . fromIntegral . bytesToWords dflags . snd) ++ (filter fst pointers) ++ body_code = mkSlideW 0 1 -- pop frame header ++ `snocOL` RETURN_T -- and add it again + + -- ----------------------------------------------------------------------------- + -- Deal with a CCall. +@@ -1148,10 +1302,10 @@ generateCCall + -> Sequel + -> BCEnv + -> CCallSpec -- where to call +- -> Id -- of target, for type info +- -> [AnnExpr' Id DVarSet] -- args (atoms) ++ -> Type ++ -> [StgArg] -- args (atoms) + -> BcM BCInstrList +-generateCCall d0 s p (CCallSpec target cconv safety _rep_ret _rep_args) fn args_r_to_l ++generateCCall d0 s p (CCallSpec target cconv safety _rep_ret _rep_args) result_ty args_r_to_l + = do + dflags <- getDynFlags + +@@ -1160,56 +1314,40 @@ generateCCall d0 s p (CCallSpec target cconv safety _rep_ret _rep_args) fn args_ + addr_size_b :: ByteOff + addr_size_b = wordSize dflags + ++ arrayish_rep_hdr_size :: TyCon -> Maybe Int ++ arrayish_rep_hdr_size t ++ | t == arrayPrimTyCon || t == mutableArrayPrimTyCon ++ = Just (arrPtrsHdrSize dflags) ++ | t == smallArrayPrimTyCon || t == smallMutableArrayPrimTyCon ++ = Just (smallArrPtrsHdrSize dflags) ++ | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon ++ = Just (arrWordsHdrSize dflags) ++ | otherwise ++ = Nothing ++ + -- Get the args on the stack, with tags and suitably + -- dereferenced for the CCall. For each arg, return the + -- depth to the first word of the bits for that arg, and the + -- ArgRep of what was actually pushed. + + pargs +- :: ByteOff -> [AnnExpr' Id DVarSet] -> BcM [(BCInstrList, PrimRep)] ++ :: ByteOff -> [StgArg] -> BcM [(BCInstrList, PrimRep)] + pargs _ [] = return [] +- pargs d (a:az) +- = let arg_ty = unwrapType (exprType (deAnnotate' a)) +- +- in case tyConAppTyCon_maybe arg_ty of +- -- Don't push the FO; instead push the Addr# it +- -- contains. +- Just t +- | t == arrayPrimTyCon || t == mutableArrayPrimTyCon +- -> do rest <- pargs (d + addr_size_b) az +- code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize dflags)) d p a +- return ((code,AddrRep):rest) +- +- | t == smallArrayPrimTyCon || t == smallMutableArrayPrimTyCon +- -> do rest <- pargs (d + addr_size_b) az +- code <- parg_ArrayishRep (fromIntegral (smallArrPtrsHdrSize dflags)) d p a +- return ((code,AddrRep):rest) +- +- | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon +- -> do rest <- pargs (d + addr_size_b) az +- code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize dflags)) d p a +- return ((code,AddrRep):rest) +- +- -- Default case: push taggedly, but otherwise intact. +- _ +- -> do (code_a, sz_a) <- pushAtom d p a +- rest <- pargs (d + sz_a) az +- return ((code_a, atomPrimRep a) : rest) +- +- -- Do magic for Ptr/Byte arrays. Push a ptr to the array on +- -- the stack but then advance it over the headers, so as to +- -- point to the payload. +- parg_ArrayishRep +- :: Word16 +- -> StackDepth +- -> BCEnv +- -> AnnExpr' Id DVarSet +- -> BcM BCInstrList +- parg_ArrayishRep hdrSize d p a +- = do (push_fo, _) <- pushAtom d p a ++ pargs d (aa@(StgVarArg a):az) ++ | Just t <- tyConAppTyCon_maybe (idType a) ++ , Just hdr_sz <- arrayish_rep_hdr_size t ++ -- Do magic for Ptr/Byte arrays. Push a ptr to the array on ++ -- the stack but then advance it over the headers, so as to ++ -- point to the payload. ++ = do rest <- pargs (d + addr_size_b) az ++ (push_fo, _) <- pushAtom d p aa + -- The ptr points at the header. Advance it over the + -- header and then pretend this is an Addr#. +- return (push_fo `snocOL` SWIZZLE 0 hdrSize) ++ let code = push_fo `snocOL` SWIZZLE 0 (fromIntegral hdr_sz) ++ return ((code, AddrRep) : rest) ++ pargs d (aa:az) = do (code_a, sz_a) <- pushAtom d p aa ++ rest <- pargs (d + sz_a) az ++ return ((code_a, atomPrimRep aa) : rest) + + code_n_reps <- pargs d0 args_r_to_l + let +@@ -1230,7 +1368,7 @@ generateCCall d0 s p (CCallSpec target cconv safety _rep_ret _rep_args) fn args_ + + -- Get the result rep. + (returns_void, r_rep) +- = case maybe_getCCallReturnRep (idType fn) of ++ = case maybe_getCCallReturnRep result_ty of + Nothing -> (True, VoidRep) + Just rr -> (False, rr) + {- +@@ -1427,14 +1565,10 @@ maybe_getCCallReturnRep fn_ty + -- valid return value placeholder on the stack + _ -> blargh + +-maybe_is_tagToEnum_call :: AnnExpr' Id DVarSet -> Maybe (AnnExpr' Id DVarSet, [Name]) ++maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (Id, [Name]) + -- Detect and extract relevant info for the tagToEnum kludge. +-maybe_is_tagToEnum_call app +- | AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType t)) arg <- app +- , Just TagToEnumOp <- isPrimOpId_maybe v +- = Just (snd arg, extract_constr_Names t) +- | otherwise +- = Nothing ++maybe_is_tagToEnum_call (StgOpApp (StgPrimOp TagToEnumOp) [StgVarArg v] t) ++ = Just (v, extract_constr_Names t) + where + extract_constr_Names ty + | rep_ty <- unwrapType ty +@@ -1445,6 +1579,7 @@ maybe_is_tagToEnum_call app + -- the DataCon. See DataCon.hs for details. + | otherwise + = pprPanic "maybe_is_tagToEnum_call.extract_constr_Ids" (ppr ty) ++maybe_is_tagToEnum_call _ = Nothing + + {- ----------------------------------------------------------------------------- + Note [Implementing tagToEnum#] +@@ -1488,13 +1623,13 @@ implement_tagToId + :: StackDepth + -> Sequel + -> BCEnv +- -> AnnExpr' Id DVarSet ++ -> Id + -> [Name] + -> BcM BCInstrList + -- See Note [Implementing tagToEnum#] + implement_tagToId d s p arg names + = ASSERT( notNull names ) +- do (push_arg, arg_bytes) <- pushAtom d p arg ++ do (push_arg, arg_bytes) <- pushAtom d p (StgVarArg arg) + labels <- getLabelsBc (genericLength names) + label_fail <- getLabelBc + label_exit <- getLabelBc +@@ -1536,21 +1671,12 @@ implement_tagToId d s p arg names + -- depth 6 stack has valid words 0 .. 5. + + pushAtom +- :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM (BCInstrList, ByteOff) +-pushAtom d p e +- | Just e' <- bcView e +- = pushAtom d p e' +- +-pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things, +- = return (nilOL, 0) -- treated just like a variable V ++ :: StackDepth -> BCEnv -> StgArg -> BcM (BCInstrList, ByteOff) + + -- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs + -- and Note [Bottoming expressions] in coreSyn/CoreUtils.hs: + -- The scrutinee of an empty case evaluates to bottom +-pushAtom d p (AnnCase (_, a) _ _ []) -- trac #12128 +- = pushAtom d p a +- +-pushAtom d p (AnnVar var) ++pushAtom d p (StgVarArg var) + | [] <- typePrimRep (idType var) + = return (nilOL, 0) + +@@ -1589,55 +1715,57 @@ pushAtom d p (AnnVar var) + = do topStrings <- getTopStrings + dflags <- getDynFlags + case lookupVarEnv topStrings var of +- Just ptr -> pushAtom d p $ AnnLit $ mkLitWord dflags $ ++ Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord dflags $ + fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr + Nothing -> do + let sz = idSizeCon dflags var + MASSERT( sz == wordSize dflags ) + return (unitOL (PUSH_G (getName var)), sz) + +- +-pushAtom _ _ (AnnLit lit) = do ++pushAtom _ _ (StgLitArg lit) = do + dflags <- getDynFlags +- let code rep +- = let size_words = WordOff (argRepSizeW dflags rep) +- in return (unitOL (PUSH_UBX lit (trunc16W size_words)), +- wordsToBytes dflags size_words) ++ let code :: PrimRep -> BcM (BCInstrList, ByteOff) ++ code rep = ++ return (unitOL instr, size_bytes) ++ where ++ size_bytes = ByteOff $ primRepSizeB dflags rep ++ -- Here we handle the non-word-width cases specifically since we ++ -- must emit different bytecode for them. ++ instr = ++ case size_bytes of ++ 1 -> PUSH_UBX8 lit ++ 2 -> PUSH_UBX16 lit ++ 4 -> PUSH_UBX32 lit ++ _ -> PUSH_UBX lit (trunc16W $ bytesToWords dflags size_bytes) + + case lit of +- LitLabel _ _ _ -> code N +- LitFloat _ -> code F +- LitDouble _ -> code D +- LitChar _ -> code N +- LitNullAddr -> code N +- LitString _ -> code N +- LitRubbish -> code N ++ LitLabel _ _ _ -> code AddrRep ++ LitFloat _ -> code FloatRep ++ LitDouble _ -> code DoubleRep ++ LitChar _ -> code AddrRep ++ LitNullAddr -> code AddrRep ++ LitString _ -> code AddrRep ++ LitRubbish -> code AddrRep + LitNumber nt _ _ -> case nt of +- LitNumInt -> code N +- LitNumWord -> code N +- LitNumInt64 -> code L +- LitNumWord64 -> code L ++ LitNumInt -> code IntRep ++ LitNumWord -> code WordRep ++ LitNumInt64 -> code Int64Rep ++ LitNumWord64 -> code Word64Rep + -- No LitInteger's or LitNatural's should be left by the time this is + -- called. CorePrep should have converted them all to a real core + -- representation. + LitNumInteger -> panic "pushAtom: LitInteger" + LitNumNatural -> panic "pushAtom: LitNatural" + +-pushAtom _ _ expr +- = pprPanic "ByteCodeGen.pushAtom" +- (pprCoreExpr (deAnnotate' expr)) +- +- + -- | Push an atom for constructor (i.e., PACK instruction) onto the stack. + -- This is slightly different to @pushAtom@ due to the fact that we allow + -- packing constructor fields. See also @mkConAppCode@ and @pushPadding@. + pushConstrAtom +- :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM (BCInstrList, ByteOff) +- +-pushConstrAtom _ _ (AnnLit lit@(LitFloat _)) = ++ :: StackDepth -> BCEnv -> StgArg -> BcM (BCInstrList, ByteOff) ++pushConstrAtom _ _ (StgLitArg lit@(LitFloat _)) = + return (unitOL (PUSH_UBX32 lit), 4) + +-pushConstrAtom d p (AnnVar v) ++pushConstrAtom d p va@(StgVarArg v) + | Just d_v <- lookupBCEnv_maybe v p = do -- v is a local variable + dflags <- getDynFlags + let !szb = idSizeCon dflags v +@@ -1648,7 +1776,7 @@ pushConstrAtom d p (AnnVar v) + 1 -> done PUSH8 + 2 -> done PUSH16 + 4 -> done PUSH32 +- _ -> pushAtom d p (AnnVar v) ++ _ -> pushAtom d p va + + pushConstrAtom d p expr = pushAtom d p expr + +@@ -1808,7 +1936,14 @@ idSizeW :: DynFlags -> Id -> WordOff + idSizeW dflags = WordOff . argRepSizeW dflags . bcIdArgRep + + idSizeCon :: DynFlags -> Id -> ByteOff +-idSizeCon dflags = ByteOff . primRepSizeB dflags . bcIdPrimRep ++idSizeCon dflags var ++ -- unboxed tuple components are padded to word size ++ | isUnboxedTupleType (idType var) || ++ isUnboxedSumType (idType var) = ++ wordsToBytes dflags . ++ WordOff . sum . map (argRepSizeW dflags . toArgRep) . ++ bcIdPrimReps $ var ++ | otherwise = ByteOff (primRepSizeB dflags (bcIdPrimRep var)) + + bcIdArgRep :: Id -> ArgRep + bcIdArgRep = toArgRep . bcIdPrimRep +@@ -1820,6 +1955,9 @@ bcIdPrimRep id + | otherwise + = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) + ++bcIdPrimReps :: Id -> [PrimRep] ++bcIdPrimReps id = typePrimRepArgs (idType id) ++ + repSizeWords :: DynFlags -> PrimRep -> WordOff + repSizeWords dflags rep = WordOff $ argRepSizeW dflags (toArgRep rep) + +@@ -1827,17 +1965,6 @@ isFollowableArg :: ArgRep -> Bool + isFollowableArg P = True + isFollowableArg _ = False + +-isVoidArg :: ArgRep -> Bool +-isVoidArg V = True +-isVoidArg _ = False +- +--- See bug #1257 +-multiValException :: a +-multiValException = throwGhcException (ProgramError +- ("Error: bytecode compiler can't handle unboxed tuples and sums.\n"++ +- " Possibly due to foreign import/export decls in source.\n"++ +- " Workaround: use -fobject-code, or compile this module to .o separately.")) +- + -- | Indicate if the calling convention is supported + isSupportedCConv :: CCallSpec -> Bool + isSupportedCConv (CCallSpec _ cconv _ _ _) = case cconv of +@@ -1873,49 +2000,11 @@ mkSlideW !n !ws + limit :: Word16 + limit = maxBound + +-splitApp :: AnnExpr' Var ann -> (AnnExpr' Var ann, [AnnExpr' Var ann]) +- -- The arguments are returned in *right-to-left* order +-splitApp e | Just e' <- bcView e = splitApp e' +-splitApp (AnnApp (_,f) (_,a)) = case splitApp f of +- (f', as) -> (f', a:as) +-splitApp e = (e, []) +- +- +-bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) +--- The "bytecode view" of a term discards +--- a) type abstractions +--- b) type applications +--- c) casts +--- d) ticks (but not breakpoints) +--- Type lambdas *can* occur in random expressions, +--- whereas value lambdas cannot; that is why they are nuked here +-bcView (AnnCast (_,e) _) = Just e +-bcView (AnnLam v (_,e)) | isTyVar v = Just e +-bcView (AnnApp (_,e) (_, AnnType _)) = Just e +-bcView (AnnTick Breakpoint{} _) = Nothing +-bcView (AnnTick _other_tick (_,e)) = Just e +-bcView _ = Nothing +- +-isVAtom :: AnnExpr' Var ann -> Bool +-isVAtom e | Just e' <- bcView e = isVAtom e' +-isVAtom (AnnVar v) = isVoidArg (bcIdArgRep v) +-isVAtom (AnnCoercion {}) = True +-isVAtom _ = False +- +-atomPrimRep :: AnnExpr' Id ann -> PrimRep +-atomPrimRep e | Just e' <- bcView e = atomPrimRep e' +-atomPrimRep (AnnVar v) = bcIdPrimRep v +-atomPrimRep (AnnLit l) = typePrimRep1 (literalType l) +- +--- #12128: +--- A case expression can be an atom because empty cases evaluate to bottom. +--- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs +-atomPrimRep (AnnCase _ _ ty _) = +- ASSERT(case typePrimRep ty of [LiftedRep] -> True; _ -> False) LiftedRep +-atomPrimRep (AnnCoercion {}) = VoidRep +-atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate' other)) ++atomPrimRep :: StgArg -> PrimRep ++atomPrimRep (StgVarArg v) = bcIdPrimRep v ++atomPrimRep (StgLitArg l) = typePrimRep1 (literalType l) + +-atomRep :: AnnExpr' Id ann -> ArgRep ++atomRep :: StgArg -> ArgRep + atomRep e = toArgRep (atomPrimRep e) + + -- | Let szsw be the sizes in bytes of some items pushed onto the stack, which +@@ -1924,8 +2013,8 @@ atomRep e = toArgRep (atomPrimRep e) + mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] + mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) + +-typeArgRep :: Type -> ArgRep +-typeArgRep = toArgRep . typePrimRep1 ++typeArgReps :: Type -> [ArgRep] ++typeArgReps = map toArgRep . typePrimRepArgs + + -- ----------------------------------------------------------------------------- + -- The bytecode generator's monad +diff --git a/compiler/ghci/ByteCodeInstr.hs b/compiler/ghci/ByteCodeInstr.hs +index c386ece52a..af7cfee394 100644 +--- a/compiler/ghci/ByteCodeInstr.hs ++++ b/compiler/ghci/ByteCodeInstr.hs +@@ -1,4 +1,5 @@ +-{-# LANGUAGE CPP, MagicHash #-} ++{-# LANGUAGE CPP #-} ++{-# LANGUAGE FlexibleContexts #-} + {-# OPTIONS_GHC -funbox-strict-fields #-} + -- + -- (c) The University of Glasgow 2002-2006 +@@ -17,22 +18,18 @@ import ByteCodeTypes + import GHCi.RemoteTypes + import GHCi.FFI (C_ffi_cif) + import GHC.StgToCmm.Layout ( ArgRep(..) ) +-import PprCore + import Outputable +-import FastString + import Name + import Unique +-import Id +-import CoreSyn + import Literal + import DataCon +-import VarSet + import PrimOp + import SMRep + + import Data.Word + import GHC.Stack.CCS (CostCentre) + ++import StgSyn + -- ---------------------------------------------------------------------------- + -- Bytecode instructions + +@@ -45,7 +42,7 @@ data ProtoBCO a + protoBCOBitmapSize :: Word16, + protoBCOArity :: Int, + -- what the BCO came from, for debugging only +- protoBCOExpr :: Either [AnnAlt Id DVarSet] (AnnExpr Id DVarSet), ++ protoBCOExpr :: Either [CgStgAlt] CgStgRhs, + -- malloc'd pointers + protoBCOFFIs :: [FFIInfo] + } +@@ -86,6 +83,9 @@ data BCInstr + -- Push an alt continuation + | PUSH_ALTS (ProtoBCO Name) + | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep ++ | PUSH_ALTS_T (ProtoBCO Name) -- continuation ++ !TupleInfo ++ (ProtoBCO Name) -- tuple return BCO + + -- Pushing 8, 16 and 32 bits of padding (for constructors). + | PUSH_PAD8 +@@ -168,8 +168,9 @@ data BCInstr + + -- To Infinity And Beyond + | ENTER +- | RETURN -- return a lifted value ++ | RETURN -- return a lifted value + | RETURN_UBX ArgRep -- return an unlifted value, here's its rep ++ | RETURN_T -- return an unboxed tuple (info already on stack) + + -- Breakpoints + | BRK_FUN Word16 Unique (RemotePtr CostCentre) +@@ -188,36 +189,45 @@ instance Outputable a => Outputable (ProtoBCO a) where + = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity + <+> text (show ffis) <> colon) + $$ nest 3 (case origin of +- Left alts -> vcat (zipWith (<+>) (char '{' : repeat (char ';')) +- (map (pprCoreAltShort.deAnnAlt) alts)) <+> char '}' +- Right rhs -> pprCoreExprShort (deAnnotate rhs)) ++ Left alts -> ++ vcat (zipWith (<+>) (char '{' : repeat (char ';')) ++ (map pprStgAltShort alts)) ++ Right rhs -> ++ pprStgRhsShort rhs ++ ) + $$ nest 3 (text "bitmap: " <+> text (show bsize) <+> ppr bitmap) + $$ nest 3 (vcat (map ppr instrs)) + +--- Print enough of the Core expression to enable the reader to find +--- the expression in the -ddump-prep output. That is, we need to ++-- Print enough of the STG expression to enable the reader to find ++-- the expression in the -ddump-stg output. That is, we need to + -- include at least a binder. + +-pprCoreExprShort :: CoreExpr -> SDoc +-pprCoreExprShort expr@(Lam _ _) +- = let +- (bndrs, _) = collectBinders expr +- in +- char '\\' <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow <+> text "..." ++pprStgExprShort :: OutputablePass pass => GenStgExpr pass -> SDoc ++pprStgExprShort (StgCase _expr var _ty _alts) = ++ text "case of" <+> ppr var ++pprStgExprShort (StgLet _ bnd _) = ++ text "let" <+> pprStgBindShort bnd <+> text "in ..." ++pprStgExprShort (StgLetNoEscape _ bnd _) = ++ text "let-no-escape" <+> pprStgBindShort bnd <+> text "in ..." ++pprStgExprShort (StgTick t e) = ppr t <+> pprStgExprShort e ++pprStgExprShort e = pprStgExpr e ++ ++pprStgBindShort :: OutputablePass pass => GenStgBinding pass -> SDoc ++pprStgBindShort (StgNonRec x _) = ++ ppr x <+> text "= ..." ++pprStgBindShort (StgRec bs) = ++ char '{' <+> ppr (fst (head bs)) <+> text "= ...; ... }" ++ ++pprStgAltShort :: OutputablePass pass => GenStgAlt pass -> SDoc ++pprStgAltShort (con, args, expr) = ++ ppr con <+> sep (map ppr args) <+> text "->" <+> pprStgExprShort expr ++ ++pprStgRhsShort :: OutputablePass pass => GenStgRhs pass -> SDoc ++pprStgRhsShort (StgRhsClosure _ext _cc upd_flag args body) = ++ hang (hsep [ char '\\' <> ppr upd_flag, brackets (interppSP args) ]) ++ 4 (pprStgExprShort body) ++pprStgRhsShort rhs = pprStgRhs rhs + +-pprCoreExprShort (Case _expr var _ty _alts) +- = text "case of" <+> ppr var +- +-pprCoreExprShort (Let (NonRec x _) _) = text "let" <+> ppr x <+> ptext (sLit ("= ... in ...")) +-pprCoreExprShort (Let (Rec bs) _) = text "let {" <+> ppr (fst (head bs)) <+> ptext (sLit ("= ...; ... } in ...")) +- +-pprCoreExprShort (Tick t e) = ppr t <+> pprCoreExprShort e +-pprCoreExprShort (Cast e _) = pprCoreExprShort e <+> text "`cast` T" +- +-pprCoreExprShort e = pprCoreExpr e +- +-pprCoreAltShort :: CoreAlt -> SDoc +-pprCoreAltShort (con, args, expr) = ppr con <+> sep (map ppr args) <+> text "->" <+> pprCoreExprShort expr + + instance Outputable BCInstr where + ppr (STKCHECK n) = text "STKCHECK" <+> ppr n +@@ -234,8 +244,13 @@ instance Outputable BCInstr where + ppr (PUSH_PRIMOP op) = text "PUSH_G " <+> text "GHC.PrimopWrappers." + <> ppr op + ppr (PUSH_BCO bco) = hang (text "PUSH_BCO") 2 (ppr bco) ++ + ppr (PUSH_ALTS bco) = hang (text "PUSH_ALTS") 2 (ppr bco) + ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco) ++ ppr (PUSH_ALTS_T bco tuple_info tuple_bco) = ++ hang (text "PUSH_ALTS_T" <+> ppr tuple_info) ++ 2 ++ (ppr tuple_bco $+$ ppr bco) + + ppr PUSH_PAD8 = text "PUSH_PAD8" + ppr PUSH_PAD16 = text "PUSH_PAD16" +@@ -292,8 +307,11 @@ instance Outputable BCInstr where + ppr ENTER = text "ENTER" + ppr RETURN = text "RETURN" + ppr (RETURN_UBX pk) = text "RETURN_UBX " <+> ppr pk ++ ppr (RETURN_T) = text "RETURN_T" + ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "" + ++ ++ + -- ----------------------------------------------------------------------------- + -- The stack use, in words, of each bytecode insn. These _must_ be + -- correct, or overestimates of reality, to be safe. +@@ -321,8 +339,14 @@ bciStackUse PUSH32_W{} = 1 -- takes exactly 1 word + bciStackUse PUSH_G{} = 1 + bciStackUse PUSH_PRIMOP{} = 1 + bciStackUse PUSH_BCO{} = 1 +-bciStackUse (PUSH_ALTS bco) = 2 + protoBCOStackUse bco +-bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco ++-- XXX these don't take stack space for restoring the CCCS into account! ++bciStackUse (PUSH_ALTS bco) = 3 + protoBCOStackUse bco ++bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 4 + protoBCOStackUse bco ++bciStackUse (PUSH_ALTS_T bco info _) = ++ -- (tuple_bco, tuple_info word, cont_bco, stg_ctoi_t) ++ -- tuple ++ -- (tuple_info, tuple_bco, stg_ret_t) ++ 7 + fromIntegral (tupleSize info) + protoBCOStackUse bco + bciStackUse (PUSH_PAD8) = 1 -- overapproximation + bciStackUse (PUSH_PAD16) = 1 -- overapproximation + bciStackUse (PUSH_PAD32) = 1 -- overapproximation on 64bit arch +@@ -361,6 +385,7 @@ bciStackUse JMP{} = 0 + bciStackUse ENTER{} = 0 + bciStackUse RETURN{} = 0 + bciStackUse RETURN_UBX{} = 1 ++bciStackUse RETURN_T{} = 1 + bciStackUse CCALL{} = 0 + bciStackUse SWIZZLE{} = 0 + bciStackUse BRK_FUN{} = 0 +diff --git a/compiler/ghci/ByteCodeTypes.hs b/compiler/ghci/ByteCodeTypes.hs +index 0c0c34ad64..617126196e 100644 +--- a/compiler/ghci/ByteCodeTypes.hs ++++ b/compiler/ghci/ByteCodeTypes.hs +@@ -5,7 +5,9 @@ + + -- | Bytecode assembler types + module ByteCodeTypes +- ( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..) ++ ( CompiledByteCode(..), seqCompiledByteCode ++ , FFIInfo(..), TupleInfo(..), voidTupleInfo ++ , ByteOff(..), WordOff(..) + , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..) + , ItblEnv, ItblPtr(..) + , CgBreakInfo(..) +@@ -67,6 +69,37 @@ seqCompiledByteCode CompiledByteCode{..} = + rnf bc_strs `seq` + rnf (fmap seqModBreaks bc_breaks) + ++newtype ByteOff = ByteOff Int ++ deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable) ++ ++newtype WordOff = WordOff Int ++ deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable) ++ ++-- This contains the data we need for passing unboxed tuples between ++-- bytecode and native code ++data TupleInfo = TupleInfo ++ { tupleSize :: !WordOff -- total size of tuple in words ++ , tupleVanillaRegs :: !Int -- vanilla registers used (bitmap) ++ , tupleLongRegs :: !Int -- long registers used (bitmap) ++ , tupleFloatRegs :: !Int -- float registers used (bitmap) ++ , tupleDoubleRegs :: !Int -- double registers used (bitmap) ++ , tupleNativeStackSize :: !WordOff {- words spilled on the stack by ++ native calling convention -} ++ } deriving (Show) ++ ++instance Outputable TupleInfo where ++ ppr TupleInfo{..} = text " ppr tupleSize <+> ++ text "stack" <+> ppr tupleNativeStackSize <+> ++ text "regs" <+> ++ char 'R' <> ppr tupleVanillaRegs <+> ++ char 'L' <> ppr tupleLongRegs <+> ++ char 'F' <> ppr tupleFloatRegs <+> ++ char 'D' <> ppr tupleDoubleRegs <> ++ char '>' ++ ++voidTupleInfo :: TupleInfo ++voidTupleInfo = TupleInfo 0 0 0 0 0 0 ++ + type ItblEnv = NameEnv (Name, ItblPtr) + -- We need the Name in the range so we know which + -- elements to filter out when unloading a module +diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs +index 077c66371e..d5a0b22ff1 100644 +--- a/compiler/iface/TcIface.hs ++++ b/compiler/iface/TcIface.hs +@@ -1372,7 +1372,7 @@ tcIfaceExpr (IfaceTick tickish expr) = do + return (Tick tickish' expr') + + ------------------------- +-tcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id) ++tcIfaceTickish :: IfaceTickish -> IfM lcl CoreTickish + tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix) + tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push) + tcIfaceTickish (IfaceSource src name) = return (SourceNote src name) +diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs +index d32a0529af..92ae16d7ea 100644 +--- a/compiler/iface/ToIface.hs ++++ b/compiler/iface/ToIface.hs +@@ -550,7 +550,7 @@ toIfaceOneShot id | isId id + = IfaceNoOneShot + + --------------------- +-toIfaceTickish :: Tickish Id -> Maybe IfaceTickish ++toIfaceTickish :: CoreTickish -> Maybe IfaceTickish + toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push) + toIfaceTickish (HpcTick modl ix) = Just (IfaceHpcTick modl ix) + toIfaceTickish (SourceNote src names) = Just (IfaceSource src names) +diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs +index dc8344d14d..b32b383510 100644 +--- a/compiler/main/GhcMake.hs ++++ b/compiler/main/GhcMake.hs +@@ -66,7 +66,6 @@ import TcBackpack + import Packages + import UniqSet + import Util +-import qualified GHC.LanguageExtensions as LangExt + import NameEnv + import FileCleanup + +@@ -2074,15 +2073,12 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots + -- otherwise those modules will fail to compile. + -- See Note [-fno-code mode] #8025 + map1 <- if hscTarget dflags == HscNothing +- then enableCodeGenForTH +- (defaultObjectTarget dflags) +- map0 +- else if hscTarget dflags == HscInterpreted +- then enableCodeGenForUnboxedTuplesOrSums +- (defaultObjectTarget dflags) +- map0 +- else return map0 ++ then enableCodeGenForTH ++ (defaultObjectTarget dflags) ++ map0 ++ else return map0 + return $ concat $ nodeMapElts map1 ++ + where + calcDeps = msDeps + +@@ -2170,30 +2166,8 @@ enableCodeGenForTH = + -- can't compile anything anyway! See #16219. + not (isIndefinite dflags) + +--- | Update the every ModSummary that is depended on +--- by a module that needs unboxed tuples. We enable codegen to +--- the specified target, disable optimization and change the .hi +--- and .o file locations to be temporary files. +--- +--- This is used used in order to load code that uses unboxed tuples +--- or sums into GHCi while still allowing some code to be interpreted. +-enableCodeGenForUnboxedTuplesOrSums :: HscTarget +- -> NodeMap [Either ErrorMessages ModSummary] +- -> IO (NodeMap [Either ErrorMessages ModSummary]) +-enableCodeGenForUnboxedTuplesOrSums = +- enableCodeGenWhen condition should_modify TFL_GhcSession TFL_CurrentModule +- where +- condition ms = +- unboxed_tuples_or_sums (ms_hspp_opts ms) && +- not (gopt Opt_ByteCodeIfUnboxed (ms_hspp_opts ms)) && +- not (isBootSummary ms) +- unboxed_tuples_or_sums d = +- xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d +- should_modify (ModSummary { ms_hspp_opts = dflags }) = +- hscTarget dflags == HscInterpreted +- +--- | Helper used to implement 'enableCodeGenForTH' and +--- 'enableCodeGenForUnboxedTuples'. In particular, this enables ++-- | Helper used to implement 'enableCodeGenForTH'. ++-- In particular, this enables + -- unoptimized code generation for all modules that meet some + -- condition (first parameter), or are dependencies of those + -- modules. The second parameter is a condition to check before +diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs +index 7d3e3bb2e3..a80f97475a 100644 +--- a/compiler/main/HscMain.hs ++++ b/compiler/main/HscMain.hs +@@ -123,8 +123,10 @@ import MkIface + import Desugar + import SimplCore + import TidyPgm ++import Unique + import CorePrep + import CoreToStg ( coreToStg ) ++import CoreUtils ( exprType ) + import qualified GHC.StgToCmm as StgToCmm ( codeGen ) + import StgSyn + import StgFVs ( annTopBindingsFreeVars ) +@@ -165,6 +167,8 @@ import Stream (Stream) + import Util + + import Data.List ( nub, isPrefixOf, partition ) ++import Data.Either ( partitionEithers ) ++ + import Control.Monad + import Data.IORef + import System.FilePath as FilePath +@@ -1432,7 +1436,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do + ----------------- Convert to STG ------------------ + (stg_binds, (caf_ccs, caf_cc_stacks)) + <- {-# SCC "CoreToStg" #-} +- myCoreToStg dflags this_mod prepd_binds ++ myCoreToStg hsc_env this_mod prepd_binds + + let cost_centre_info = + (S.toList local_ccs ++ caf_ccs, caf_cc_stacks) +@@ -1494,8 +1498,12 @@ hscInteractive hsc_env cgguts location = do + -- Do saturation and convert to A-normal form + (prepd_binds, _) <- {-# SCC "CorePrep" #-} + corePrepPgm hsc_env this_mod location core_binds data_tycons ++ ++ (stg_binds, _caf_ccs__caf_cc_stacks) ++ <- {-# SCC "CoreToStg" #-} ++ myCoreToStg hsc_env this_mod prepd_binds + ----------------- Generate byte code ------------------ +- comp_bc <- byteCodeGen hsc_env this_mod prepd_binds data_tycons mod_breaks ++ comp_bc <- byteCodeGen hsc_env this_mod stg_binds data_tycons mod_breaks + ------------------ Create f-x-dynamic C-side stuff ----- + (_istub_h_exists, istub_c_exists) + <- outputForeignStubs dflags this_mod location foreign_stubs +@@ -1572,21 +1580,20 @@ doCodeGen hsc_env this_mod data_tycons + + + +-myCoreToStg :: DynFlags -> Module -> CoreProgram ++myCoreToStg :: HscEnv -> Module -> CoreProgram + -> IO ( [StgTopBinding] -- output program + , CollectedCCs ) -- CAF cost centre info (declared and used) +-myCoreToStg dflags this_mod prepd_binds = do ++myCoreToStg hsc_env this_mod prepd_binds = do + let (stg_binds, cost_centre_info) + = {-# SCC "Core2Stg" #-} +- coreToStg dflags this_mod prepd_binds ++ coreToStg (hsc_dflags hsc_env) this_mod prepd_binds + + stg_binds2 + <- {-# SCC "Stg2Stg" #-} +- stg2stg dflags this_mod stg_binds ++ stg2stg hsc_env this_mod stg_binds + + return (stg_binds2, cost_centre_info) + +- + {- ********************************************************************** + %* * + \subsection{Compiling a do-statement} +@@ -1722,9 +1729,13 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do + (prepd_binds, _) <- {-# SCC "CorePrep" #-} + liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons + ++ (stg_binds, _caf_ccs__caf_cc_stacks) ++ <- {-# SCC "CoreToStg" #-} ++ liftIO $ myCoreToStg hsc_env this_mod prepd_binds ++ + {- Generate byte code -} + cbc <- liftIO $ byteCodeGen hsc_env this_mod +- prepd_binds data_tycons mod_breaks ++ stg_binds data_tycons mod_breaks + + let src_span = srcLocSpan interactiveSrcLoc + liftIO $ linkDecls hsc_env src_span cbc +@@ -1887,9 +1898,38 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr + {- Lint if necessary -} + ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr + ++ {- Create a temporary binding and convert to STG -} ++ ; let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel") ++ (mkPseudoUniqueE 0) ++ (exprType prepd_expr) ++ ; (binds, _) <- ++ myCoreToStg hsc_env ++ (icInteractiveModule (hsc_IC hsc_env)) ++ [NonRec bco_tmp_id prepd_expr] ++ ++ ; let (_strings, lifted_binds) = partitionEithers $ do -- list monad ++ bnd <- binds ++ case bnd of ++ StgTopLifted (StgNonRec i expr) -> [Right (i, expr)] ++ StgTopLifted (StgRec bnds) -> map Right bnds ++ StgTopStringLit b str -> [Left (b, str)] ++ ++ ; let stg_expr = case lifted_binds of ++ [(_i, e)] -> e ++ _ -> ++ StgRhsClosure noExtFieldSilent ++ dontCareCCS ++ ReEntrant ++ [] ++ (StgLet noExtFieldSilent ++ (StgRec lifted_binds) ++ (StgApp bco_tmp_id [])) ++ + {- Convert to BCOs -} + ; bcos <- coreExprToBCOs hsc_env +- (icInteractiveModule (hsc_IC hsc_env)) prepd_expr ++ (icInteractiveModule (hsc_IC hsc_env)) ++ bco_tmp_id ++ stg_expr + + {- link it -} + ; hval <- linkExpr hsc_env srcspan bcos +diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs +index ae491ac02d..2131b0f30c 100644 +--- a/compiler/main/TidyPgm.hs ++++ b/compiler/main/TidyPgm.hs +@@ -769,7 +769,7 @@ dffvExpr :: CoreExpr -> DFFV () + dffvExpr (Var v) = insert v + dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2 + dffvExpr (Lam v e) = extendScope v (dffvExpr e) +-dffvExpr (Tick (Breakpoint _ ids) e) = mapM_ insert ids >> dffvExpr e ++dffvExpr (Tick (Breakpoint _ _ ids) e) = mapM_ insert ids >> dffvExpr e + dffvExpr (Tick _other e) = dffvExpr e + dffvExpr (Cast e _) = dffvExpr e + dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e) +diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs +index 33f1c5b2f7..9b252bc01c 100644 +--- a/compiler/nativeGen/Dwarf.hs ++++ b/compiler/nativeGen/Dwarf.hs +@@ -7,7 +7,7 @@ import GhcPrelude + import CLabel + import CmmExpr ( GlobalReg(..) ) + import Config ( cProjectName, cProjectVersion ) +-import CoreSyn ( Tickish(..) ) ++import CoreSyn ( CmmTickish, GenTickish(..) ) + import Debug + import DynFlags + import Module +@@ -207,7 +207,7 @@ blockToDwarf df blk + | Just _ <- dblPosition blk = Just $ mkAsmTempLabel $ dblLabel blk + | otherwise = Nothing -- block was optimized out + +-tickToDwarf :: DynFlags -> Tickish () -> [DwarfInfo] ++tickToDwarf :: DynFlags -> CmmTickish -> [DwarfInfo] + tickToDwarf _ (SourceNote ss _) = [DwarfSrcNote ss] + tickToDwarf _ _ = [] + +diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs +index f02f04d68f..e3199311b3 100644 +--- a/compiler/nativeGen/X86/CodeGen.hs ++++ b/compiler/nativeGen/X86/CodeGen.hs +@@ -69,7 +69,7 @@ import Hoopl.Collections + import Hoopl.Graph + import Hoopl.Label + import CLabel +-import CoreSyn ( Tickish(..) ) ++import CoreSyn ( GenTickish(..) ) + import SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol ) + + -- The rest: +diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs +index 015d096a0a..e594aa2e73 100644 +--- a/compiler/simplCore/FloatOut.hs ++++ b/compiler/simplCore/FloatOut.hs +@@ -733,7 +733,7 @@ atJoinCeiling (fs, floats, expr') + where + (floats', ceils) = partitionAtJoinCeiling floats + +-wrapTick :: Tickish Id -> FloatBinds -> FloatBinds ++wrapTick :: CoreTickish -> FloatBinds -> FloatBinds + wrapTick t (FB tops ceils defns) + = FB (mapBag wrap_bind tops) (wrap_defns ceils) + (M.map (M.map wrap_defns) defns) +diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs +index 0ff1823894..799a7d7edb 100644 +--- a/compiler/simplCore/OccurAnal.hs ++++ b/compiler/simplCore/OccurAnal.hs +@@ -1708,7 +1708,7 @@ occAnal env (Tick tickish body) + | tickish `tickishScopesLike` SoftScope + = (markAllNonTailCalled usage, Tick tickish body') + +- | Breakpoint _ ids <- tickish ++ | Breakpoint _ _ ids <- tickish + = (usage_lam `andUDs` foldr addManyOccs emptyDetails ids, Tick tickish body') + -- never substitute for any of the Ids in a Breakpoint + +@@ -1841,7 +1841,7 @@ Constructors are rather like lambdas in this way. + -} + + occAnalApp :: OccEnv +- -> (Expr CoreBndr, [Arg CoreBndr], [Tickish Id]) ++ -> (Expr CoreBndr, [Arg CoreBndr], [CoreTickish]) + -> (UsageDetails, Expr CoreBndr) + occAnalApp env (Var fun, args, ticks) + | null ticks = (uds, mkApps (Var fun) args') +diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs +index 149a079a0a..45e9036162 100644 +--- a/compiler/simplCore/SimplCore.hs ++++ b/compiler/simplCore/SimplCore.hs +@@ -900,7 +900,7 @@ ticks. More often than not, other references will be unfoldings of + x_exported, and therefore carry the tick anyway. + -} + +-type IndEnv = IdEnv (Id, [Tickish Var]) -- Maps local_id -> exported_id, ticks ++type IndEnv = IdEnv (Id, [CoreTickish]) -- Maps local_id -> exported_id, ticks + + shortOutIndirections :: CoreProgram -> CoreProgram + shortOutIndirections binds +diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs +index 60ba0ab0a1..39486df3af 100644 +--- a/compiler/simplCore/SimplUtils.hs ++++ b/compiler/simplCore/SimplUtils.hs +@@ -157,7 +157,7 @@ data SimplCont + , sc_cont :: SimplCont } + + | TickIt -- (TickIt t K)[e] = K[ tick t e ] +- (Tickish Id) -- Tick tickish ++ CoreTickish -- Tick tickish + SimplCont + + type StaticEnv = SimplEnv -- Just the static part is relevant +diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs +index 8f211b931f..480d388c70 100644 +--- a/compiler/simplCore/Simplify.hs ++++ b/compiler/simplCore/Simplify.hs +@@ -5,6 +5,7 @@ + -} + + {-# LANGUAGE CPP #-} ++{-# LANGUAGE TypeFamilies #-} + + {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + module Simplify ( simplTopBinds, simplExpr, simplRules ) where +@@ -1063,7 +1064,7 @@ simplCoercion env co + -- long as this is a non-scoping tick, to let case and application + -- optimisations apply. + +-simplTick :: SimplEnv -> Tickish Id -> InExpr -> SimplCont ++simplTick :: SimplEnv -> CoreTickish -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) + simplTick env tickish expr cont + -- A scoped tick turns into a continuation, so that we can spot +@@ -1157,8 +1158,8 @@ simplTick env tickish expr cont + + + simplTickish env tickish +- | Breakpoint n ids <- tickish +- = Breakpoint n (map (getDoneId . substId env) ids) ++ | Breakpoint ext n ids <- tickish ++ = Breakpoint ext n (map (getDoneId . substId env) ids) + | otherwise = tickish + + -- Push type application and coercion inside a tick +diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs +index 89b7d4205e..a05d66788d 100644 +--- a/compiler/simplStg/SimplStg.hs ++++ b/compiler/simplStg/SimplStg.hs +@@ -17,6 +17,7 @@ import GhcPrelude + + import StgSyn + ++import HscTypes ( HscEnv, hsc_dflags ) + import StgLint ( lintStgTopBindings ) + import StgStats ( showStgStats ) + import UnariseStg ( unarise ) +@@ -44,12 +45,12 @@ instance MonadUnique StgM where + runStgM :: Char -> StgM a -> IO a + runStgM mask (StgM m) = evalStateT m mask + +-stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do ++stg2stg :: HscEnv -- includes spec of what stg-to-stg passes to do + -> Module -- module being compiled + -> [StgTopBinding] -- input program + -> IO [StgTopBinding] -- output program + +-stg2stg dflags this_mod binds ++stg2stg hsc_env this_mod binds + = do { dump_when Opt_D_dump_stg "STG:" binds + ; showPass dflags "Stg2Stg" + -- Do the main business! +@@ -62,9 +63,10 @@ stg2stg dflags this_mod binds + } + + where ++ dflags = hsc_dflags hsc_env + stg_linter unarised + | gopt Opt_DoStgLinting dflags +- = lintStgTopBindings dflags this_mod unarised ++ = lintStgTopBindings hsc_env this_mod unarised + | otherwise + = \ _whodunnit _binds -> return () + +diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs +index 0990115f67..b4b9155c7c 100644 +--- a/compiler/specialise/Specialise.hs ++++ b/compiler/specialise/Specialise.hs +@@ -1077,9 +1077,9 @@ specLam env bndrs body + ; return (mkLams bndrs (wrapDictBindsE dumped_dbs body'), free_uds) } + + -------------- +-specTickish :: SpecEnv -> Tickish Id -> Tickish Id +-specTickish env (Breakpoint ix ids) +- = Breakpoint ix [ id' | id <- ids, Var id' <- [specVar env id]] ++specTickish :: SpecEnv -> CoreTickish -> CoreTickish ++specTickish env (Breakpoint ext ix ids) ++ = Breakpoint ext ix [ id' | id <- ids, Var id' <- [specVar env id]] + -- drop vars from the list if they have a non-variable substitution. + -- should never happen, but it's harmless to drop them anyway. + specTickish _ other_tickish = other_tickish +diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs +index 4e75ad04a2..0bd18e6763 100644 +--- a/compiler/stgSyn/CoreToStg.hs ++++ b/compiler/stgSyn/CoreToStg.hs +@@ -1,4 +1,6 @@ + {-# LANGUAGE CPP, DeriveFunctor #-} ++{-# LANGUAGE BangPatterns #-} ++{-# LANGUAGE TypeFamilies #-} + + -- + -- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 +@@ -429,13 +431,10 @@ coreToStgExpr expr@(Lam _ _) + return result_expr + + coreToStgExpr (Tick tick expr) +- = do case tick of +- HpcTick{} -> return () +- ProfNote{} -> return () +- SourceNote{} -> return () +- Breakpoint{} -> panic "coreToStgExpr: breakpoint should not happen" ++ = do ++ let !stg_tick = coreToStgTick (exprType expr) tick + expr2 <- coreToStgExpr expr +- return (StgTick tick expr2) ++ return (StgTick stg_tick expr2) + + coreToStgExpr (Cast expr _) + = coreToStgExpr expr +@@ -526,7 +525,7 @@ mkStgAltType bndr alts + + coreToStgApp :: Id -- Function + -> [CoreArg] -- Arguments +- -> [Tickish Id] -- Debug ticks ++ -> [CoreTickish] -- Debug ticks + -> CtsM StgExpr + coreToStgApp f args ticks = do + (args', ticks') <- coreToStgArgs args +@@ -572,7 +571,8 @@ coreToStgApp f args ticks = do + TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args') + _other -> StgApp f args' + +- tapp = foldr StgTick app (ticks ++ ticks') ++ add_tick !t !e = StgTick t e ++ tapp = foldr add_tick app (map (coreToStgTick res_ty) ticks ++ ticks') + + -- Forcing these fixes a leak in the code generator, noticed while + -- profiling for trac #4367 +@@ -583,7 +583,7 @@ coreToStgApp f args ticks = do + -- This is the guy that turns applications into A-normal form + -- --------------------------------------------------------------------------- + +-coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [Tickish Id]) ++coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish]) + coreToStgArgs [] + = return ([], []) + +@@ -598,7 +598,8 @@ coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion token + coreToStgArgs (Tick t e : args) + = ASSERT( not (tickishIsCode t) ) + do { (args', ts) <- coreToStgArgs (e : args) +- ; return (args', t:ts) } ++ ; let !t' = coreToStgTick (exprType e) t ++ ; return (args', t':ts) } + + coreToStgArgs (arg : args) = do -- Non-type argument + (stg_args, ticks) <- coreToStgArgs args +@@ -630,6 +631,13 @@ coreToStgArgs (arg : args) = do -- Non-type argument + WARN( bad_args, text "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" $$ ppr arg ) + return (stg_arg : stg_args, ticks ++ aticks) + ++coreToStgTick :: Type -- type of the ticked expression ++ -> CoreTickish ++ -> StgTickish ++coreToStgTick _ty (HpcTick m i) = HpcTick m i ++coreToStgTick _ty (SourceNote span nm) = SourceNote span nm ++coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope ++coreToStgTick !ty (Breakpoint _ bid fvs) = Breakpoint ty bid fvs + + -- --------------------------------------------------------------------------- + -- The magic for lets: +@@ -936,7 +944,7 @@ myCollectBinders expr + + -- | Precondition: argument expression is an 'App', and there is a 'Var' at the + -- head of the 'App' chain. +-myCollectArgs :: CoreExpr -> (Id, [CoreArg], [Tickish Id]) ++myCollectArgs :: CoreExpr -> (Id, [CoreArg], [CoreTickish]) + myCollectArgs expr + = go expr [] [] + where +diff --git a/compiler/stgSyn/StgFVs.hs b/compiler/stgSyn/StgFVs.hs +index edfc94ed2d..22bb20b97c 100644 +--- a/compiler/stgSyn/StgFVs.hs ++++ b/compiler/stgSyn/StgFVs.hs +@@ -1,4 +1,5 @@ + -- | Free variable analysis on STG terms. ++{-# LANGUAGE TypeFamilies #-} + module StgFVs ( + annTopBindingsFreeVars, + annBindingFreeVars +@@ -9,7 +10,7 @@ import GhcPrelude + import StgSyn + import Id + import VarSet +-import CoreSyn ( Tickish(Breakpoint) ) ++import CoreSyn ( GenTickish(Breakpoint) ) + import Outputable + import Util + +@@ -103,8 +104,8 @@ expr env = go + where + (e', fvs) = go e + fvs' = unionDVarSet (tickish tick) fvs +- tickish (Breakpoint _ ids) = mkDVarSet ids +- tickish _ = emptyDVarSet ++ tickish (Breakpoint _ _ ids) = mkDVarSet ids ++ tickish _ = emptyDVarSet + + go_bind dc bind body = (dc bind' body', fvs) + where +diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs +index f83b44859c..f6fb1357e8 100644 +--- a/compiler/stgSyn/StgLint.hs ++++ b/compiler/stgSyn/StgLint.hs +@@ -40,6 +40,8 @@ module StgLint ( lintStgTopBindings ) where + import GhcPrelude + + import StgSyn ++import HscTypes ++import CoreLint ( interactiveInScope ) + + import DynFlags + import Bag ( Bag, emptyBag, isEmptyBag, snocBag, bagToList ) +@@ -61,14 +63,14 @@ import Control.Applicative ((<|>)) + import Control.Monad + + lintStgTopBindings :: forall a . (OutputablePass a, BinderP a ~ Id) +- => DynFlags ++ => HscEnv + -> Module -- ^ module being compiled + -> Bool -- ^ have we run Unarise yet? + -> String -- ^ who produced the STG? + -> [GenStgTopBinding a] + -> IO () + +-lintStgTopBindings dflags this_mod unarised whodunnit binds ++lintStgTopBindings hsc_env this_mod unarised whodunnit binds + = {-# SCC "StgLint" #-} + case initL this_mod unarised top_level_binds (lint_binds binds) of + Nothing -> +@@ -84,9 +86,12 @@ lintStgTopBindings dflags this_mod unarised whodunnit binds + text "*** End of Offense ***"]) + Err.ghcExit dflags 1 + where ++ dflags = hsc_dflags hsc_env + -- Bring all top-level binds into scope because CoreToStg does not generate + -- bindings in dependency order (so we may see a use before its definition). +- top_level_binds = mkVarSet (bindersOfTopBinds binds) ++ top_level_binds = mkVarSet (bindersOfTopBinds binds ++ ++ interactiveInScope hsc_env ++ ) + + lint_binds :: [GenStgTopBinding a] -> LintM () + +diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs +index 052ef2b6c7..22b9d159ca 100644 +--- a/compiler/stgSyn/StgSyn.hs ++++ b/compiler/stgSyn/StgSyn.hs +@@ -54,14 +54,15 @@ module StgSyn ( + stripStgTicksTop, stripStgTicksTopE, + stgCaseBndrInScope, + +- pprStgBinding, pprGenStgTopBindings, pprStgTopBindings ++ pprStgBinding, pprGenStgTopBindings, pprStgTopBindings, ++ pprStgExpr, pprStgRhs + ) where + + #include "HsVersions.h" + + import GhcPrelude + +-import CoreSyn ( AltCon, Tickish ) ++import CoreSyn ( AltCon, StgTickish ) + import CostCentre ( CostCentreStack ) + import Data.ByteString ( ByteString ) + import Data.Data ( Data ) +@@ -168,13 +169,13 @@ stgArgType (StgLitArg lit) = literalType lit + + + -- | Strip ticks of a given type from an STG expression. +-stripStgTicksTop :: (Tickish Id -> Bool) -> GenStgExpr p -> ([Tickish Id], GenStgExpr p) ++stripStgTicksTop :: (StgTickish -> Bool) -> GenStgExpr p -> ([StgTickish], GenStgExpr p) + stripStgTicksTop p = go [] + where go ts (StgTick t e) | p t = go (t:ts) e + go ts other = (reverse ts, other) + + -- | Strip ticks of a given type from an STG expression returning only the expression. +-stripStgTicksTopE :: (Tickish Id -> Bool) -> GenStgExpr p -> GenStgExpr p ++stripStgTicksTopE :: (StgTickish -> Bool) -> GenStgExpr p -> GenStgExpr p + stripStgTicksTopE p = go + where go (StgTick t e) | p t = go e + go other = other +@@ -376,7 +377,7 @@ Finally for @hpc@ expressions we introduce a new STG construct. + -} + + | StgTick +- (Tickish Id) ++ StgTickish + (GenStgExpr pass) -- sub expression + + -- END of GenStgExpr +diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs +index a9de7ac1f6..b2288b0742 100644 +--- a/compiler/typecheck/TcBinds.hs ++++ b/compiler/typecheck/TcBinds.hs +@@ -20,7 +20,7 @@ import GhcPrelude + import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun ) + import {-# SOURCE #-} TcExpr ( tcMonoExpr ) + import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynBuilderBind ) +-import CoreSyn (Tickish (..)) ++import CoreSyn (CoreTickish, GenTickish (..)) + import CostCentre (mkUserCC, CCFlavour(DeclCC)) + import DynFlags + import FastString +@@ -738,7 +738,7 @@ tcPolyCheck _prag_fn sig bind + = pprPanic "tcPolyCheck" (ppr sig $$ ppr bind) + + funBindTicks :: SrcSpan -> TcId -> Module -> [LSig GhcRn] +- -> TcM [Tickish TcId] ++ -> TcM [CoreTickish] + funBindTicks loc fun_id mod sigs + | (mb_cc_str : _) <- [ cc_name | (dL->L _ (SCCFunSig _ _ _ cc_name)) <- sigs ] + -- this can only be a singleton list, as duplicate pragmas are rejected +diff --git a/includes/rts/Bytecodes.h b/includes/rts/Bytecodes.h +index e5d55f694f..88748ea184 100644 +--- a/includes/rts/Bytecodes.h ++++ b/includes/rts/Bytecodes.h +@@ -91,6 +91,9 @@ + #define bci_BRK_FUN 66 + #define bci_TESTLT_W 67 + #define bci_TESTEQ_W 68 ++ ++#define bci_RETURN_T 69 ++#define bci_PUSH_ALTS_T 70 + /* If you need to go past 255 then you will run into the flags */ + + /* If you need to go below 0x0100 then you will run into the instructions */ +diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h +index 5b2364407f..f98401cc98 100644 +--- a/includes/stg/MiscClosures.h ++++ b/includes/stg/MiscClosures.h +@@ -87,6 +87,41 @@ RTS_RET(stg_ctoi_D1); + RTS_RET(stg_ctoi_L1); + RTS_RET(stg_ctoi_V); + ++RTS_FUN_DECL(stg_ctoi_t); ++RTS_RET(stg_ctoi_t0); ++RTS_RET(stg_ctoi_t1); ++RTS_RET(stg_ctoi_t2); ++RTS_RET(stg_ctoi_t3); ++RTS_RET(stg_ctoi_t4); ++RTS_RET(stg_ctoi_t5); ++RTS_RET(stg_ctoi_t6); ++RTS_RET(stg_ctoi_t7); ++RTS_RET(stg_ctoi_t8); ++RTS_RET(stg_ctoi_t9); ++RTS_RET(stg_ctoi_t10); ++RTS_RET(stg_ctoi_t11); ++RTS_RET(stg_ctoi_t12); ++RTS_RET(stg_ctoi_t13); ++RTS_RET(stg_ctoi_t14); ++RTS_RET(stg_ctoi_t15); ++RTS_RET(stg_ctoi_t16); ++RTS_RET(stg_ctoi_t17); ++RTS_RET(stg_ctoi_t18); ++RTS_RET(stg_ctoi_t19); ++RTS_RET(stg_ctoi_t20); ++RTS_RET(stg_ctoi_t21); ++RTS_RET(stg_ctoi_t22); ++RTS_RET(stg_ctoi_t23); ++RTS_RET(stg_ctoi_t24); ++RTS_RET(stg_ctoi_t25); ++RTS_RET(stg_ctoi_t26); ++RTS_RET(stg_ctoi_t27); ++RTS_RET(stg_ctoi_t28); ++RTS_RET(stg_ctoi_t29); ++RTS_RET(stg_ctoi_t30); ++RTS_RET(stg_ctoi_t31); ++RTS_RET(stg_ctoi_t32); ++ + RTS_RET(stg_apply_interp); + + RTS_ENTRY(stg_IND); +@@ -293,6 +328,7 @@ RTS_RET(stg_ret_n); + RTS_RET(stg_ret_f); + RTS_RET(stg_ret_d); + RTS_RET(stg_ret_l); ++RTS_RET(stg_ret_t); + + RTS_FUN_DECL(stg_gc_prim); + RTS_FUN_DECL(stg_gc_prim_p); +diff --git a/rts/Disassembler.c b/rts/Disassembler.c +index 01d6c3b1d9..bae23c1f17 100644 +--- a/rts/Disassembler.c ++++ b/rts/Disassembler.c +@@ -148,6 +148,13 @@ disInstr ( StgBCO *bco, int pc ) + debugBelch("PUSH_ALTS_V " ); printPtr( ptrs[instrs[pc]] ); + debugBelch("\n"); + pc += 1; break; ++ case bci_PUSH_ALTS_T: ++ debugBelch("PUSH_ALTS_T "); ++ printPtr( ptrs[instrs[pc]] ); ++ debugBelch(" 0x%" FMT_HexWord " ", literals[instrs[pc+1]] ); ++ printPtr( ptrs[instrs[pc+2]] ); ++ debugBelch("\n"); ++ pc += 3; break; + case bci_PUSH_PAD8: + debugBelch("PUSH_PAD8\n"); + pc += 1; break; +@@ -313,6 +320,9 @@ disInstr ( StgBCO *bco, int pc ) + case bci_RETURN_V: + debugBelch("RETURN_V\n" ); + break; ++ case bci_RETURN_T: ++ debugBelch("RETURN_T\n "); ++ break; + + default: + barf("disInstr: unknown opcode %u", (unsigned int) instr); +diff --git a/rts/Interpreter.c b/rts/Interpreter.c +index 463ddae18b..49d881e2e0 100644 +--- a/rts/Interpreter.c ++++ b/rts/Interpreter.c +@@ -4,6 +4,7 @@ + * Copyright (c) The GHC Team, 1994-2002. + * ---------------------------------------------------------------------------*/ + ++ + #include "PosixSource.h" + #include "Rts.h" + #include "RtsAPI.h" +@@ -681,12 +682,13 @@ do_return_unboxed: + || SpW(0) == (W_)&stg_ret_f_info + || SpW(0) == (W_)&stg_ret_d_info + || SpW(0) == (W_)&stg_ret_l_info ++ || SpW(0) == (W_)&stg_ret_t_info + ); + + IF_DEBUG(interpreter, + debugBelch( + "\n---------------------------------------------------------------\n"); +- debugBelch("Returning: "); printObj(obj); ++ debugBelch("Returning unboxed\n"); + debugBelch("Sp = %p\n", Sp); + #if defined(PROFILING) + fprintCCS(stderr, cap->r.rCCCS); +@@ -697,7 +699,7 @@ do_return_unboxed: + debugBelch("\n\n"); + ); + +- // get the offset of the stg_ctoi_ret_XXX itbl ++ // get the offset of the header of the next stack frame + offset = stack_frame_sizeW((StgClosure *)Sp); + + switch (get_itbl((StgClosure*)(Sp_plusW(offset)))->type) { +@@ -934,6 +936,43 @@ run_BCO_return_unboxed: + // Stack checks aren't necessary at return points, the stack use + // is aggregated into the enclosing function entry point. + ++#if defined(PROFILING) ++ /* ++ Restore the current cost centre stack if a tuple is being returned. ++ ++ When a "simple" unboxed value is returned, the cccs is restored with ++ an stg_restore_cccs frame on the stack, for example: ++ ++ ... ++ stg_ctoi_D1 ++ ++ stg_restore_cccs ++ ++ But stg_restore_cccs cannot deal with tuples, which may have more ++ things on the stack. Therefore we store the CCCS inside the ++ stg_ctoi_t frame. ++ ++ If we have a tuple being returned, the stack looks like this: ++ ++ ... ++ <- to restore, Sp offset ++ tuple_BCO ++ tuple_info ++ cont_BCO ++ stg_ctoi_t <- next frame ++ tuple_data_1 ++ ... ++ tuple_data_n ++ tuple_info ++ tuple_BCO ++ stg_ret_t <- Sp ++ */ ++ ++ if(SpW(0) == (W_)&stg_ret_t_info) { ++ cap->r.rCCCS = (CostCentreStack*)SpW(stack_frame_sizeW((StgClosure *)Sp) + 4); ++ } ++#endif ++ + goto run_BCO; + + run_BCO_fun: +@@ -1326,6 +1365,64 @@ run_BCO: + goto nextInsn; + } + ++ case bci_PUSH_ALTS_T: { ++ int o_bco = BCO_GET_LARGE_ARG; ++ W_ tuple_info = (W_)BCO_LIT(BCO_GET_LARGE_ARG); ++ int o_tuple_bco = BCO_GET_LARGE_ARG; ++ ++#if defined(PROFILING) ++ SpW(-1) = (W_)cap->r.rCCCS; ++ Sp_subW(1); ++#endif ++ ++ SpW(-1) = BCO_PTR(o_tuple_bco); ++ SpW(-2) = tuple_info; ++ SpW(-3) = BCO_PTR(o_bco); ++ W_ ctoi_t_offset; ++ int tuple_stack_words = tuple_info & 0x3fff; ++ switch(tuple_stack_words) { ++ case 0: ctoi_t_offset = (W_)&stg_ctoi_t0_info; break; ++ case 1: ctoi_t_offset = (W_)&stg_ctoi_t1_info; break; ++ case 2: ctoi_t_offset = (W_)&stg_ctoi_t2_info; break; ++ case 3: ctoi_t_offset = (W_)&stg_ctoi_t3_info; break; ++ case 4: ctoi_t_offset = (W_)&stg_ctoi_t4_info; break; ++ case 5: ctoi_t_offset = (W_)&stg_ctoi_t5_info; break; ++ case 6: ctoi_t_offset = (W_)&stg_ctoi_t6_info; break; ++ case 7: ctoi_t_offset = (W_)&stg_ctoi_t7_info; break; ++ case 8: ctoi_t_offset = (W_)&stg_ctoi_t8_info; break; ++ case 9: ctoi_t_offset = (W_)&stg_ctoi_t9_info; break; ++ case 10: ctoi_t_offset = (W_)&stg_ctoi_t10_info; break; ++ case 11: ctoi_t_offset = (W_)&stg_ctoi_t11_info; break; ++ case 12: ctoi_t_offset = (W_)&stg_ctoi_t12_info; break; ++ case 13: ctoi_t_offset = (W_)&stg_ctoi_t13_info; break; ++ case 14: ctoi_t_offset = (W_)&stg_ctoi_t14_info; break; ++ case 15: ctoi_t_offset = (W_)&stg_ctoi_t15_info; break; ++ case 16: ctoi_t_offset = (W_)&stg_ctoi_t16_info; break; ++ case 17: ctoi_t_offset = (W_)&stg_ctoi_t17_info; break; ++ case 18: ctoi_t_offset = (W_)&stg_ctoi_t18_info; break; ++ case 19: ctoi_t_offset = (W_)&stg_ctoi_t19_info; break; ++ case 20: ctoi_t_offset = (W_)&stg_ctoi_t20_info; break; ++ case 21: ctoi_t_offset = (W_)&stg_ctoi_t21_info; break; ++ case 22: ctoi_t_offset = (W_)&stg_ctoi_t22_info; break; ++ case 23: ctoi_t_offset = (W_)&stg_ctoi_t23_info; break; ++ case 24: ctoi_t_offset = (W_)&stg_ctoi_t24_info; break; ++ case 25: ctoi_t_offset = (W_)&stg_ctoi_t25_info; break; ++ case 26: ctoi_t_offset = (W_)&stg_ctoi_t26_info; break; ++ case 27: ctoi_t_offset = (W_)&stg_ctoi_t27_info; break; ++ case 28: ctoi_t_offset = (W_)&stg_ctoi_t28_info; break; ++ case 29: ctoi_t_offset = (W_)&stg_ctoi_t29_info; break; ++ case 30: ctoi_t_offset = (W_)&stg_ctoi_t30_info; break; ++ case 31: ctoi_t_offset = (W_)&stg_ctoi_t31_info; break; ++ case 32: ctoi_t_offset = (W_)&stg_ctoi_t32_info; break; ++ ++ default: barf("unsupported tuple size %d", tuple_stack_words); ++ } ++ ++ SpW(-4) = ctoi_t_offset; ++ Sp_subW(4); ++ goto nextInsn; ++ } ++ + case bci_PUSH_APPLY_N: + Sp_subW(1); SpW(0) = (W_)&stg_ap_n_info; + goto nextInsn; +@@ -1705,6 +1802,12 @@ run_BCO: + Sp_subW(1); + SpW(0) = (W_)&stg_ret_v_info; + goto do_return_unboxed; ++ case bci_RETURN_T: { ++ /* tuple_info and tuple_bco must already be on the stack */ ++ Sp_subW(1); ++ SpW(0) = (W_)&stg_ret_t_info; ++ goto do_return_unboxed; ++ } + + case bci_SWIZZLE: { + int stkoff = BCO_NEXT; +diff --git a/rts/Printer.c b/rts/Printer.c +index 15404e1205..ab2119cf78 100644 +--- a/rts/Printer.c ++++ b/rts/Printer.c +@@ -528,17 +528,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) + + case RET_SMALL: { + StgWord c = *sp; +- if (c == (StgWord)&stg_ctoi_R1p_info) { +- debugBelch("tstg_ctoi_ret_R1p_info\n" ); +- } else if (c == (StgWord)&stg_ctoi_R1n_info) { +- debugBelch("stg_ctoi_ret_R1n_info\n" ); +- } else if (c == (StgWord)&stg_ctoi_F1_info) { +- debugBelch("stg_ctoi_ret_F1_info\n" ); +- } else if (c == (StgWord)&stg_ctoi_D1_info) { +- debugBelch("stg_ctoi_ret_D1_info\n" ); +- } else if (c == (StgWord)&stg_ctoi_V_info) { +- debugBelch("stg_ctoi_ret_V_info\n" ); +- } else if (c == (StgWord)&stg_ap_v_info) { ++ if (c == (StgWord)&stg_ap_v_info) { + debugBelch("stg_ap_v_info\n" ); + } else if (c == (StgWord)&stg_ap_f_info) { + debugBelch("stg_ap_f_info\n" ); +@@ -594,11 +584,51 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) + } + + case RET_BCO: { +- StgBCO *bco; +- +- bco = ((StgBCO *)sp[1]); ++ StgWord c = *sp; ++ StgBCO *bco = ((StgBCO *)sp[1]); + +- debugBelch("RET_BCO (%p)\n", sp); ++ if (c == (StgWord)&stg_ctoi_R1p_info) { ++ debugBelch("stg_ctoi_R1p_info" ); ++ } else if (c == (StgWord)&stg_ctoi_R1unpt_info) { ++ debugBelch("stg_ctoi_R1unpt_info" ); ++ } else if (c == (StgWord)&stg_ctoi_R1n_info) { ++ debugBelch("stg_ctoi_R1n_info" ); ++ } else if (c == (StgWord)&stg_ctoi_F1_info) { ++ debugBelch("stg_ctoi_F1_info" ); ++ } else if (c == (StgWord)&stg_ctoi_D1_info) { ++ debugBelch("stg_ctoi_D1_info" ); ++ } else if (c == (StgWord)&stg_ctoi_V_info) { ++ debugBelch("stg_ctoi_V_info" ); ++ } else if (c == (StgWord)&stg_BCO_info) { ++ debugBelch("stg_BCO_info" ); ++ } else if (c == (StgWord)&stg_apply_interp_info) { ++ debugBelch("stg_apply_interp_info" ); ++ } else if (c == (StgWord)&stg_ret_t_info) { ++ debugBelch("stg_ret_t_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t0_info) { ++ debugBelch("stg_ctoi_t0_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t1_info) { ++ debugBelch("stg_ctoi_t1_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t2_info) { ++ debugBelch("stg_ctoi_t2_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t3_info) { ++ debugBelch("stg_ctoi_t3_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t4_info) { ++ debugBelch("stg_ctoi_t4_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t5_info) { ++ debugBelch("stg_ctoi_t5_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t6_info) { ++ debugBelch("stg_ctoi_t6_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t7_info) { ++ debugBelch("stg_ctoi_t7_info" ); ++ } else if (c == (StgWord)&stg_ctoi_t8_info) { ++ debugBelch("stg_ctoi_t8_info" ); ++ /* there are more stg_ctoi_tN_info frames, ++ but we don't print them all */ ++ } else { ++ debugBelch("RET_BCO"); ++ } ++ debugBelch(" (%p)\n", sp); + printLargeBitmap(spBottom, sp+2, + BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco)); + continue; +diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c +index d5b8cc5fec..407eb29cb1 100644 +--- a/rts/RtsSymbols.c ++++ b/rts/RtsSymbols.c +@@ -562,6 +562,8 @@ + SymI_HasProto(stg_ret_f_info) \ + SymI_HasProto(stg_ret_d_info) \ + SymI_HasProto(stg_ret_l_info) \ ++ SymI_HasProto(stg_ret_t_info) \ ++ SymI_HasProto(stg_ctoi_t) \ + SymI_HasProto(stg_gc_prim_p) \ + SymI_HasProto(stg_gc_prim_pp) \ + SymI_HasProto(stg_gc_prim_n) \ +diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm +index 44d7d302e5..fdc4bc75a2 100644 +--- a/rts/StgMiscClosures.cmm ++++ b/rts/StgMiscClosures.cmm +@@ -195,6 +195,240 @@ INFO_TABLE_RET( stg_ctoi_V, RET_BCO ) + jump stg_yield_to_interpreter []; + } + ++/* In the calling convention for compiled code, a tuple is returned ++ in registers, with everything that doesn't fit spilled onto the STG ++ stack. ++ ++ At the time the continuation is called, Sp points to the highest word ++ used on the stack: ++ ++ ... ++ stg_ctoi_t (next stack frame, continuation) ++ spilled_1 ++ spilled_2 ++ spilled_3 <- Sp ++ ++ This makes it difficult to write a procedure that can handle tuples of ++ any size. ++ ++ To get around this, we use a Cmm procedure that adjusts the stack pointer ++ to skip over the tuple: ++ ++ ... ++ stg_ctoi_t3 (advances Sp by 3 words, then calls stg_ctoi_t) ++ spilled_1 ++ spilled_2 ++ spilled_3 <- Sp ++ ++ When stg_ctoi_t is called, the stack looks like: ++ ++ ... ++ tuple_BCO ++ tuple_info ++ cont_BCO (continuation in bytecode) ++ stg_ctoi_t3 <- Sp ++ spilled_1 ++ spilled_2 ++ spilled_3 ++ ++ stg_ctoi_t then reads the tuple_info word to determine the registers ++ to save onto the stack and construct a call to tuple_BCO. Afterwards the ++ stack looks as follows: ++ ++ ... ++ tuple_BCO ++ tuple_info ++ cont_BCO ++ stg_ctoi_t3 ++ spilled_1 ++ spilled_2 ++ spilled_3 ++ saved_R2 ++ saved_R1 ++ saved_D3 ++ ... ++ tuple_BCO ++ stg_apply_interp <- Sp ++ ++ ++ tuple_BCO contains the bytecode instructions to return the tuple to ++ cont_BCO. The bitmap in tuple_BCO describes the contents of ++ the tuple to the storage manager. ++ ++ At this point we can safely jump to the interpreter. ++ ++ */ ++ ++#define MK_STG_CTOI_T(N) INFO_TABLE_RET( \ ++ stg_ctoi_t ## N, RET_BCO ) \ ++ { Sp_adj(N); jump stg_ctoi_t [*]; } ++ ++MK_STG_CTOI_T(0) ++MK_STG_CTOI_T(1) ++MK_STG_CTOI_T(2) ++MK_STG_CTOI_T(3) ++MK_STG_CTOI_T(4) ++MK_STG_CTOI_T(5) ++MK_STG_CTOI_T(6) ++MK_STG_CTOI_T(7) ++MK_STG_CTOI_T(8) ++MK_STG_CTOI_T(9) ++MK_STG_CTOI_T(10) ++MK_STG_CTOI_T(11) ++MK_STG_CTOI_T(12) ++MK_STG_CTOI_T(13) ++MK_STG_CTOI_T(14) ++MK_STG_CTOI_T(15) ++MK_STG_CTOI_T(16) ++MK_STG_CTOI_T(17) ++MK_STG_CTOI_T(18) ++MK_STG_CTOI_T(19) ++MK_STG_CTOI_T(20) ++MK_STG_CTOI_T(21) ++MK_STG_CTOI_T(22) ++MK_STG_CTOI_T(23) ++MK_STG_CTOI_T(24) ++MK_STG_CTOI_T(25) ++MK_STG_CTOI_T(26) ++MK_STG_CTOI_T(27) ++MK_STG_CTOI_T(28) ++MK_STG_CTOI_T(29) ++MK_STG_CTOI_T(30) ++MK_STG_CTOI_T(31) ++MK_STG_CTOI_T(32) ++ ++/* ++ the tuple_info word describes the register and stack usage of the tuple: ++ ++ [ rrrr ffff ffdd dddd llss ssss ssss ssss ] ++ ++ - r: number of vanilla registers R1..Rn ++ - f: bitmap of float registers F1..F6 ++ - d: bitmap of double registers D1..D6 ++ - l: bitmap of long registers L1..Ln ++ - s: size of tuple in words on stack ++ ++ the order in which the registers are pushed on the stack is determined by ++ the Ord instance of GHC.Cmm.Expr.GlobalReg ++ ++ */ ++ ++stg_ctoi_t ++ /* explicit stack */ ++{ ++ ++ W_ tuple_info, tuple_stack, tuple_regs_R, ++ tuple_regs_F, tuple_regs_D, tuple_regs_L; ++ P_ tuple_BCO; ++ ++ tuple_info = Sp(2); /* tuple information word */ ++ tuple_BCO = Sp(3); /* bytecode object that returns the tuple in ++ the interpreter */ ++ ++#if defined(PROFILING) ++ CCCS = Sp(4); ++#endif ++ ++ tuple_stack = tuple_info & 0x3fff; /* number of words spilled on stack */ ++ tuple_regs_R = (tuple_info >> 28) & 0xf; /* number of R1..Rn */ ++ tuple_regs_F = (tuple_info >> 22) & 0x3f; /* 6 bits bitmap */ ++ tuple_regs_D = (tuple_info >> 16) & 0x3f; /* 6 bits bitmap */ ++ tuple_regs_L = (tuple_info >> 14) & 0x3; /* 2 bits bitmap */ ++ ++ Sp = Sp - WDS(tuple_stack); ++ ++ /* save long registers */ ++ /* fixme L2 ? */ ++ if((tuple_regs_L & 1) != 0) { Sp = Sp - 8; L_[Sp] = L1; } ++ ++ /* save double registers */ ++ if((tuple_regs_D & 32) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D6; } ++ if((tuple_regs_D & 16) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D5; } ++ if((tuple_regs_D & 8) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D4; } ++ if((tuple_regs_D & 4) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D3; } ++ if((tuple_regs_D & 2) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D2; } ++ if((tuple_regs_D & 1) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D1; } ++ ++ /* save float registers */ ++ if((tuple_regs_F & 32) != 0) { Sp_adj(-1); F_[Sp] = F6; } ++ if((tuple_regs_F & 16) != 0) { Sp_adj(-1); F_[Sp] = F5; } ++ if((tuple_regs_F & 8) != 0) { Sp_adj(-1); F_[Sp] = F4; } ++ if((tuple_regs_F & 4) != 0) { Sp_adj(-1); F_[Sp] = F3; } ++ if((tuple_regs_F & 2) != 0) { Sp_adj(-1); F_[Sp] = F2; } ++ if((tuple_regs_F & 1) != 0) { Sp_adj(-1); F_[Sp] = F1; } ++ ++ /* save vanilla registers */ ++ if(tuple_regs_R >= 6) { Sp_adj(-1); Sp(0) = R6; } ++ if(tuple_regs_R >= 5) { Sp_adj(-1); Sp(0) = R5; } ++ if(tuple_regs_R >= 4) { Sp_adj(-1); Sp(0) = R4; } ++ if(tuple_regs_R >= 3) { Sp_adj(-1); Sp(0) = R3; } ++ if(tuple_regs_R >= 2) { Sp_adj(-1); Sp(0) = R2; } ++ if(tuple_regs_R >= 1) { Sp_adj(-1); Sp(0) = R1; } ++ ++ /* jump to the BCO that will finish the return of the tuple */ ++ Sp_adj(-3); ++ Sp(2) = tuple_info; ++ Sp(1) = tuple_BCO; ++ Sp(0) = stg_ret_t_info; ++ ++ jump stg_yield_to_interpreter []; ++} ++ ++INFO_TABLE_RET( stg_ret_t, RET_BCO ) ++{ ++ W_ tuple_info, tuple_stack, tuple_regs_R, tuple_regs_F, ++ tuple_regs_D, tuple_regs_L; ++ ++ tuple_info = Sp(2); ++ Sp_adj(3); ++ ++ tuple_stack = tuple_info & 0x3fff; /* number of words spilled on stack */ ++ tuple_regs_R = (tuple_info >> 28) & 0xf; /* number of R1..Rn */ ++ tuple_regs_F = (tuple_info >> 22) & 0x3f; /* 6 bits bitmap */ ++ tuple_regs_D = (tuple_info >> 16) & 0x3f; /* 6 bits bitmap */ ++ tuple_regs_L = (tuple_info >> 14) & 0x3; /* 2 bits bitmap */ ++ ++ /* ccall debugBelch("stg_ret_t: stack%d R%d F%d D%d L%d\n", ++ tuple_stack, ++ tuple_regs_R, ++ tuple_regs_F, ++ tuple_regs_D, ++ tuple_regs_L); */ ++ ++ /* restore everything in the reverse order of stg_ctoi_t */ ++ ++ /* restore vanilla registers */ ++ if(tuple_regs_R >= 1) { R1 = Sp(0); Sp_adj(1); } ++ if(tuple_regs_R >= 2) { R2 = Sp(0); Sp_adj(1); } ++ if(tuple_regs_R >= 3) { R3 = Sp(0); Sp_adj(1); } ++ if(tuple_regs_R >= 4) { R4 = Sp(0); Sp_adj(1); } ++ if(tuple_regs_R >= 5) { R5 = Sp(0); Sp_adj(1); } ++ if(tuple_regs_R >= 6) { R6 = Sp(0); Sp_adj(1); } ++ ++ /* restore float registers */ ++ if((tuple_regs_F & 1) != 0) { F1 = F_[Sp]; Sp_adj(1); } ++ if((tuple_regs_F & 2) != 0) { F2 = F_[Sp]; Sp_adj(1); } ++ if((tuple_regs_F & 4) != 0) { F3 = F_[Sp]; Sp_adj(1); } ++ if((tuple_regs_F & 8) != 0) { F4 = F_[Sp]; Sp_adj(1); } ++ if((tuple_regs_F & 16) != 0) { F5 = F_[Sp]; Sp_adj(1); } ++ if((tuple_regs_F & 32) != 0) { F6 = F_[Sp]; Sp_adj(1); } ++ ++ /* restore double registers */ ++ if((tuple_regs_D & 1) != 0) { D1 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } ++ if((tuple_regs_D & 2) != 0) { D2 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } ++ if((tuple_regs_D & 4) != 0) { D3 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } ++ if((tuple_regs_D & 8) != 0) { D4 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } ++ if((tuple_regs_D & 16) != 0) { D5 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } ++ if((tuple_regs_D & 32) != 0) { D6 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } ++ ++ /* restore long registers */ ++ if((tuple_regs_L & 1) != 0) { L1 = L_[Sp]; Sp = Sp + 8; } ++ ++ /* Sp points to the topmost argument now */ ++ jump %ENTRY_CODE(Sp(tuple_stack)) [*]; // NB. all registers live! ++} ++ ++ + /* + * Dummy info table pushed on the top of the stack when the interpreter + * should apply the BCO on the stack to its arguments, also on the +diff --git a/testsuite/tests/ghci/should_run/UnboxedTuples/ByteCode.hs b/testsuite/tests/ghci/should_run/UnboxedTuples/ByteCode.hs +new file mode 100644 +index 0000000000..a1bce35ad0 +--- /dev/null ++++ b/testsuite/tests/ghci/should_run/UnboxedTuples/ByteCode.hs +@@ -0,0 +1,17 @@ ++{-# LANGUAGE CPP, UnboxedTuples, MagicHash, ScopedTypeVariables, PolyKinds #-} ++{-# OPTIONS_GHC -fbyte-code #-} ++ ++#include "MachDeps.h" ++ ++#if WORD_SIZE_IN_BITS < 64 ++#define WW Word64 ++#else ++#define WW Word ++#endif ++ ++module ByteCode where ++ ++import GHC.Exts ++import GHC.Word ++ ++#include "Common.hs-incl" +diff --git a/testsuite/tests/ghci/should_run/UnboxedTuples/Common.hs-incl b/testsuite/tests/ghci/should_run/UnboxedTuples/Common.hs-incl +new file mode 100644 +index 0000000000..6931397f09 +--- /dev/null ++++ b/testsuite/tests/ghci/should_run/UnboxedTuples/Common.hs-incl +@@ -0,0 +1,368 @@ ++swap :: (# a, b #) -> (# b, a #) ++swap (# x, y #) = (# y, x #) ++ ++type T1 a = a -> (# a #) ++tuple1 :: T1 a ++tuple1 x = (# x #) ++ ++tuple1_a :: T1 a -> a -> a ++tuple1_a f x = case f x of (# y #) -> y ++ ++tuple1_b :: T1 a -> a -> String -> IO () ++tuple1_b f x msg = case f x of (# _ #) -> putStrLn msg ++ ++-- can still be returned in registers, pointers ++type T2p a = a -> a -> a -> a -> (# a, a, a, a #) ++ ++tuple2p :: T2p a ++tuple2p x1 x2 x3 x4 = (# x1, x2, x3, x4 #) ++ ++tuple2p_a :: T2p a -> a -> a -> a -> a -> (a, a, a, a) ++tuple2p_a f x1 x2 x3 x4 = ++ case f x1 x2 x3 x4 of (# y1, y2, y3, y4 #) -> (y1, y2, y3, y4) ++ ++-- can still be returned in registers, non-pointers ++type T2n = Int -> Int -> Int -> Int -> (# Int#, Int#, Int#, Int# #) ++ ++tuple2n :: T2n ++tuple2n (I# x1) (I# x2) (I# x3) (I# x4) = (# x1, x2, x3, x4 #) ++ ++tuple2n_a :: T2n -> Int -> Int -> Int -> Int -> (Int, Int, Int, Int) ++tuple2n_a f x1 x2 x3 x4 = ++ case f x1 x2 x3 x4 of ++ (# y1, y2, y3, y4 #) -> (I# y1, I# y2, I# y3, I# y4) ++ ++ ++-- too big to fit in registers ++type T3 a = a -> a -> a -> a ++ -> a -> a -> a -> a ++ -> a -> a -> a -> a ++ -> (# a, a, a, a ++ , a, a, a, a ++ , a, a, a, a #) ++tuple3 :: T3 a ++tuple3 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 = ++ (# x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12 #) ++ ++tuple3_a :: T3 a ++ -> a -> a -> a -> a ++ -> a -> a -> a -> a ++ -> a -> a -> a -> a ++ -> ( a, a, a, a ++ , a, a, a, a ++ , a, a, a, a ++ ) ++tuple3_a f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 = ++ case f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 of ++ (# y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12 #) -> ++ (y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12) ++ ++type T4a = Float -> Double -> Float -> Double ++ -> (# Float#, Double#, Float#, Double# #) ++ ++tuple4a :: T4a ++tuple4a (F# f1) (D# d1) (F# f2) (D# d2) = (# f1, d1, f2, d2 #) ++ ++tuple4a_a :: T4a ++ -> Float -> Double -> Float -> Double ++ -> (Float, Double, Float, Double) ++tuple4a_a h f1 d1 f2 d2 = ++ case h f1 d1 f2 d2 of (# g1, e1, g2, e2 #) -> (F# g1, D# e1, F# g2, D# e2 ) ++ ++ ++-- this should fill the floating point registers ++type T4b = Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> (# Float#, Double#, Float#, Double# ++ , Float#, Double#, Float#, Double# ++ , Float#, Double#, Float#, Double# ++ , Float#, Double#, Float#, Double# ++ , Float#, Double#, Float#, Double# #) ++tuple4b :: T4b ++tuple4b (F# f1) (D# d1) (F# f2) (D# d2) ++ (F# f3) (D# d3) (F# f4) (D# d4) ++ (F# f5) (D# d5) (F# f6) (D# d6) ++ (F# f7) (D# d7) (F# f8) (D# d8) ++ (F# f9) (D# d9) (F# f10) (D# d10) = ++ (# f1, d1, f2, d2 ++ , f3, d3, f4, d4 ++ , f5, d5, f6, d6 ++ , f7, d7, f8, d8 ++ , f9, d9, f10, d10 ++ #) ++ ++tuple4b_a :: T4b ++ -> Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> Float -> Double -> Float -> Double ++ -> ( (Float, Double, Float, Double) ++ , (Float, Double, Float, Double) ++ , (Float, Double, Float, Double) ++ , (Float, Double, Float, Double) ++ , (Float, Double, Float, Double) ++ ) ++tuple4b_a h f1 d1 f2 d2 ++ f3 d3 f4 d4 ++ f5 d5 f6 d6 ++ f7 d7 f8 d8 ++ f9 d9 f10 d10 = ++ case h f1 d1 f2 d2 ++ f3 d3 f4 d4 ++ f5 d5 f6 d6 ++ f7 d7 f8 d8 ++ f9 d9 f10 d10 of ++ (# g1, e1, g2, e2 ++ , g3, e3, g4, e4 ++ , g5, e5, g6, e6 ++ , g7, e7, g8, e8 ++ , g9, e9, g10, e10 #) -> ++ ( (F# g1, D# e1, F# g2, D# e2) ++ , (F# g3, D# e3, F# g4, D# e4) ++ , (F# g5, D# e5, F# g6, D# e6) ++ , (F# g7, D# e7, F# g8, D# e8) ++ , (F# g9, D# e9, F# g10, D# e10)) ++ ++type T4c = Float -> Double -> Word64 -> Integer ++ -> Float -> Double -> Word64 -> Integer ++ -> Float -> Double -> Word64 -> Integer ++ -> Float -> Double -> Word64 -> Integer ++ -> (# Float#, Double#, WW#, Integer ++ , Float#, Double#, WW#, Integer ++ , Float#, Double#, WW#, Integer ++ , Float#, Double#, WW#, Integer ++ #) ++tuple4c :: T4c ++tuple4c (F# f1) (D# d1) (W64# w1) i1 ++ (F# f2) (D# d2) (W64# w2) i2 ++ (F# f3) (D# d3) (W64# w3) i3 ++ (F# f4) (D# d4) (W64# w4) i4 = ++ (# f1, d1, w1, i1 ++ , f2, d2, w2, i2 ++ , f3, d3, w3, i3 ++ , f4, d4, w4, i4 ++ #) ++ ++tuple4c_a :: T4c ++ -> Float -> Double -> Word64 -> Integer ++ -> Float -> Double -> Word64 -> Integer ++ -> Float -> Double -> Word64 -> Integer ++ -> Float -> Double -> Word64 -> Integer ++ -> ( ( Float, Double, Word64, Integer) ++ , ( Float, Double, Word64, Integer) ++ , ( Float, Double, Word64, Integer) ++ , ( Float, Double, Word64, Integer) ++ ) ++tuple4c_a h f1 d1 w1 i1 ++ f2 d2 w2 i2 ++ f3 d3 w3 i3 ++ f4 d4 w4 i4 = ++ case h f1 d1 w1 i1 ++ f2 d2 w2 i2 ++ f3 d3 w3 i3 ++ f4 d4 w4 i4 of ++ (# f1', d1', w1', i1' ++ , f2', d2', w2', i2' ++ , f3', d3', w3', i3' ++ , f4', d4', w4', i4' #) -> ++ ( (F# f1', D# d1', W64# w1', i1') ++ , (F# f2', D# d2', W64# w2', i2') ++ , (F# f3', D# d3', W64# w3', i3') ++ , (F# f4', D# d4', W64# w4', i4') ++ ) ++ ++type T5 = Int -> Word64 -> Int -> Word64 ++ -> Int -> Word64 -> Int -> Word64 ++ -> Int -> Word64 -> Int -> Word64 ++ -> Int -> Word64 -> Int -> Word64 ++ -> (# Int, WW#, Int, WW# ++ , Int, WW#, Int, WW# ++ , Int, WW#, Int, WW# ++ , Int, WW#, Int, WW# ++ #) ++ ++tuple5 :: T5 ++tuple5 i1 (W64# w1) i2 (W64# w2) ++ i3 (W64# w3) i4 (W64# w4) ++ i5 (W64# w5) i6 (W64# w6) ++ i7 (W64# w7) i8 (W64# w8) = ++ (# i1, w1, i2, w2 ++ , i3, w3, i4, w4 ++ , i5, w5, i6, w6 ++ , i7, w7, i8, w8 #) ++ ++tuple5_a :: T5 ++ -> Int -> Word64 -> Int -> Word64 ++ -> Int -> Word64 -> Int -> Word64 ++ -> Int -> Word64 -> Int -> Word64 ++ -> Int -> Word64 -> Int -> Word64 ++ -> ( (Int, Word64, Int, Word64) ++ , (Int, Word64, Int, Word64) ++ , (Int, Word64, Int, Word64) ++ , (Int, Word64, Int, Word64) ++ ) ++tuple5_a f i1 w1 i2 w2 ++ i3 w3 i4 w4 ++ i5 w5 i6 w6 ++ i7 w7 i8 w8 = ++ case f i1 w1 i2 w2 ++ i3 w3 i4 w4 ++ i5 w5 i6 w6 ++ i7 w7 i8 w8 of ++ (# j1, x1, j2, x2 ++ , j3, x3, j4, x4 ++ , j5, x5, j6, x6 ++ , j7, x7, j8, x8 ++ #) -> ++ ( (j1, W64# x1, j2, W64# x2) ++ , (j3, W64# x3, j4, W64# x4) ++ , (j5, W64# x5, j6, W64# x6) ++ , (j7, W64# x7, j8, W64# x8) ++ ) ++ ++type T6 = Int -> ++ (# Int#, (# Int, (# Int#, (# #) #) #) #) ++tuple6 :: T6 ++tuple6 x@(I# x#) = (# x#, (# x, (# x#, (# #) #) #) #) ++ ++tuple6_a :: T6 -> Int -> String ++tuple6_a f x = ++ case f x of ++ (# x1, (# x2, (# x3, (# #) #) #) #) -> show (I# x1, (x2, (I# x3, ()))) ++ ++-- empty tuples and tuples with void ++ ++type TV1 = Bool -> (# #) ++ ++{-# NOINLINE tuple_v1 #-} ++tuple_v1 :: TV1 ++tuple_v1 _ = (# #) ++ ++{-# NOINLINE tuple_v1_a #-} ++tuple_v1_a :: TV1 -> Bool -> Bool ++tuple_v1_a f x = case f x of (# #) -> True ++ ++ ++type TV2 = Bool -> (# (# #) #) ++ ++{-# NOINLINE tuple_v2 #-} ++tuple_v2 :: TV2 ++tuple_v2 _ = (# (# #) #) ++ ++{-# NOINLINE tuple_v2_a #-} ++tuple_v2_a :: TV2 -> Bool -> Bool ++tuple_v2_a f x = case f x of (# _ #) -> True ++ ++ ++type TV3 a = a -> (# (# #), a #) ++ ++{-# NOINLINE tuple_v3 #-} ++tuple_v3 :: TV3 a ++tuple_v3 x = (# (# #), x #) ++ ++{-# NOINLINE tuple_v3_a #-} ++tuple_v3_a :: TV3 a -> a -> a ++tuple_v3_a f x = case f x of (# _, y #) -> y ++ ++ ++type TV4 a = a -> (# a, (# #) #) ++ ++{-# NOINLINE tuple_v4 #-} ++tuple_v4 :: TV4 a ++tuple_v4 x = (# x, (# #) #) ++ ++{-# NOINLINE tuple_v4_a #-} ++tuple_v4_a :: TV4 a -> a -> a ++tuple_v4_a f x = case f x of (# y, _ #) -> y ++ ++ ++type TV5 a = a -> (# (# #), a, (# #) #) ++ ++{-# NOINLINE tuple_v5 #-} ++tuple_v5 :: TV5 a ++tuple_v5 x = (# (# #), x, (# #) #) ++ ++{-# NOINLINE tuple_v5_a #-} ++tuple_v5_a :: TV5 a -> a -> a ++tuple_v5_a f x = case f x of (# _, x, _ #) -> x ++ ++ ++type TV6 = Int -> Double -> Int -> Double ++ -> (# Int#, (# #), Double#, (# #) ++ , Int#, (# #), Double#, (# #) #) ++ ++{-# NOINLINE tuple_v6 #-} ++tuple_v6 :: TV6 ++tuple_v6 (I# x) (D# y) (I# z) (D# w) = (# x, (# #), y, (# #), z, (# #), w, (# #) #) ++ ++{-# NOINLINE tuple_v6_a #-} ++tuple_v6_a :: TV6 -> Int -> Double -> Int -> Double ++ -> (Int, Double, Int, Double) ++tuple_v6_a f x y z w = case f x y z w of (# x', _, y', _, z', _, w', _ #) -> ++ (I# x', D# y', I# z', D# w') ++ ++-- some levity polymorphic things ++{-# NOINLINE lev_poly #-} ++lev_poly :: forall r a (b :: TYPE r). ++ (a -> a -> a -> a -> ++ a -> a -> a -> a -> ++ a -> a -> a -> a -> b) -> a -> b ++lev_poly f x = f x x x x x x x x x x x x ++ ++{-# NOINLINE lev_poly_a #-} ++lev_poly_a :: (t1 ++ -> t2 -> (# a, b, c, d, e, f, g, h, i, j, k, l #)) ++ -> t1 -> t2 -> (a, b, c, d, e, f, g, h, i, j, k, l) ++lev_poly_a lp t x = ++ case lp t x of (# x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12 #) -> ++ (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) ++ ++{-# NOINLINE lev_poly_boxed #-} ++lev_poly_boxed x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ++ = (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) ++ ++{-# NOINLINE lev_poly_b #-} ++lev_poly_b lp t x = ++ case lp t x of (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) ++ -> (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) ++ ++-- some unboxed sums ++type S1 = (# (# Int#, String #) | Bool #) ++ ++{-# NOINLINE sum1 #-} ++sum1 :: Int -> Int -> String -> Bool -> S1 ++sum1 0 (I# x) y _ = (# (# x, y #) | #) ++sum1 _ _ _ b = (# | b #) ++ ++{-# NOINLINE sum1_a #-} ++sum1_a :: (Int -> Int -> String -> Bool -> S1) -> Int -> Int -> String -> Bool -> Either (Int, String) Bool ++sum1_a f n x y b = ++ case f n x y b of ++ (# (# x, y #) | #) -> Left (I# x, y) ++ (# | b #) -> Right b ++ ++ ++type S2 a = (# (# a, a, a, a #) | (# a, a #) | (# #) | Int# | Int #) ++ ++{-# NOINLINE sum2 #-} ++sum2 :: Int -> a -> S2 a ++sum2 0 x = (# (# x, x, x, x #) | | | | #) ++sum2 1 x = (# | (# x, x #) | | | #) ++sum2 2 _ = (# | | (# #) | | #) ++sum2 n@(I# n#) _ ++ | even n = (# | | | n# | #) ++ | otherwise = (# | | | | n #) ++ ++{-# NOINLINE sum2_a #-} ++sum2_a :: Show a => (Int -> a -> S2 a) -> Int -> a -> String ++sum2_a f n x = ++ case f n x of ++ (# (# x1, x2, x3, x4 #) | | | | #) -> show (x1, x2, x3, x4) ++ (# | (# x1, x2 #) | | | #) -> show (x1, x2) ++ (# | | (# #) | | #) -> "(# #)" ++ (# | | | x# | #) -> show (I# x#) ++ "#" ++ (# | | | | x #) -> show x +diff --git a/testsuite/tests/ghci/should_run/UnboxedTuples/Obj.hs b/testsuite/tests/ghci/should_run/UnboxedTuples/Obj.hs +new file mode 100644 +index 0000000000..190b8f1683 +--- /dev/null ++++ b/testsuite/tests/ghci/should_run/UnboxedTuples/Obj.hs +@@ -0,0 +1,17 @@ ++{-# LANGUAGE CPP, UnboxedTuples, MagicHash, ScopedTypeVariables, PolyKinds #-} ++{-# OPTIONS_GHC -fobject-code #-} ++ ++#include "MachDeps.h" ++ ++#if WORD_SIZE_IN_BITS < 64 ++#define WW Word64 ++#else ++#define WW Word ++#endif ++ ++module Obj where ++ ++import GHC.Exts ++import GHC.Word ++ ++#include "Common.hs-incl" +diff --git a/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs b/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs +new file mode 100644 +index 0000000000..1daec7f207 +--- /dev/null ++++ b/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs +@@ -0,0 +1,182 @@ ++{-# LANGUAGE UnboxedTuples, MagicHash #-} ++{-# OPTIONS_GHC -fbyte-code #-} ++ ++{- ++ Test unboxed tuples and sums in the bytecode interpreter. ++ ++ The bytecode interpreter uses the stack for everything, while ++ compiled code uses STG registers for arguments and return values. ++ -} ++ ++module Main where ++ ++import qualified Obj as O ++import qualified ByteCode as B ++ ++import GHC.Exts ++import GHC.Word ++ ++main :: IO () ++main = do ++ ++ case B.swap (O.swap (B.swap (O.swap (# "x", 1 #)))) of ++ (# y1, y2 #) -> print (y1, y2) ++ ++ -- one-tuples ++ testX "tuple1" ++ B.tuple1_a O.tuple1_a ++ B.tuple1 O.tuple1 ++ (\f -> f 90053) ++ ++ -- check that the contents of a one-tuple aren't evaluated ++ B.tuple1_b B.tuple1 (error "error tuple1_b") "tuple1_b" ++ B.tuple1_b O.tuple1 (error "error tuple1_b") "tuple1_b" ++ O.tuple1_b B.tuple1 (error "error tuple1_b") "tuple1_b" ++ O.tuple1_b O.tuple1 (error "error tuple1_b") "tuple1_b" ++ ++ -- various size tuples with boxed/unboxed elements ++ testX "tuple2p" ++ B.tuple2p_a O.tuple2p_a ++ B.tuple2p O.tuple2p ++ (\f -> f (1234::Integer) 1235 1236 1237) ++ ++ testX "tuple2n" ++ B.tuple2n_a O.tuple2n_a ++ B.tuple2n O.tuple2n ++ (\f -> f 7654 7653 7652 7651) ++ ++ testX "tuple3" ++ B.tuple3_a O.tuple3_a ++ B.tuple3 O.tuple3 ++ (\f -> f (1000::Integer) 1001 1002 1003 ++ 1004 1005 1006 1007 ++ 1008 1009 1010 1011) ++ ++ testX "tuple4a" ++ B.tuple4a_a O.tuple4a_a ++ B.tuple4a O.tuple4a ++ (\f -> f 2000 2001 2002 2003) ++ ++ testX "tuple4b" ++ B.tuple4b_a O.tuple4b_a ++ B.tuple4b O.tuple4b ++ (\f -> f 3000 3001 3002 3003 ++ 3004 3005 3006 3007 ++ 3008 3009 3010 3011 ++ 3012 3013 3014 3015 ++ 3016 3017 3018 3019) ++ ++ testX "tuple4c" ++ B.tuple4c_a O.tuple4c_a ++ B.tuple4c O.tuple4c ++ (\f -> f 3000 3001 3002 3003 ++ 3004 3005 3006 3007 ++ 3008 3009 3010 3011 ++ 3012 3013 3014 3015) ++ ++ testX "tuple5" ++ B.tuple5_a O.tuple5_a ++ B.tuple5 O.tuple5 ++ (\f -> f 4000 4001 4002 4003 ++ 4004 4005 4006 4007 ++ 4008 4009 4010 4011 ++ 4012 4013 4014 4015) ++ ++ testX "tuple6" ++ B.tuple6_a O.tuple6_a ++ B.tuple6 O.tuple6 ++ (\f -> f 6006) ++ ++ -- tuples with void and empty tuples ++ testX "tuplev1" ++ B.tuple_v1_a O.tuple_v1_a ++ B.tuple_v1 O.tuple_v1 ++ (\f -> f False) ++ ++ testX "tuplev2" ++ B.tuple_v2_a O.tuple_v2_a ++ B.tuple_v2 O.tuple_v2 ++ (\f -> f False) ++ ++ testX "tuplev3" ++ B.tuple_v3_a O.tuple_v3_a ++ B.tuple_v3 O.tuple_v3 ++ (\f -> f 30001) ++ ++ testX "tuplev4" ++ B.tuple_v4_a O.tuple_v4_a ++ B.tuple_v4 O.tuple_v4 ++ (\f -> f 40001) ++ ++ testX "tuplev5" ++ B.tuple_v5_a O.tuple_v5_a ++ B.tuple_v5 O.tuple_v5 ++ (\f -> f 50001) ++ ++ testX "tuplev6" ++ B.tuple_v6_a O.tuple_v6_a ++ B.tuple_v6 O.tuple_v6 ++ (\f -> f 601 602 603 604) ++ ++ -- levity polymorphic ++ print $ B.lev_poly_a B.lev_poly B.tuple3 991 ++ print $ B.lev_poly_a B.lev_poly O.tuple3 992 ++ print $ B.lev_poly_a O.lev_poly B.tuple3 993 ++ print $ B.lev_poly_a O.lev_poly O.tuple3 994 ++ print $ O.lev_poly_a B.lev_poly B.tuple3 995 ++ print $ O.lev_poly_a B.lev_poly O.tuple3 996 ++ print $ O.lev_poly_a O.lev_poly B.tuple3 997 ++ print $ O.lev_poly_a O.lev_poly O.tuple3 998 ++ ++ print $ B.lev_poly_b B.lev_poly B.lev_poly_boxed 981 ++ print $ B.lev_poly_b B.lev_poly O.lev_poly_boxed 982 ++ print $ B.lev_poly_b O.lev_poly B.lev_poly_boxed 983 ++ print $ B.lev_poly_b O.lev_poly O.lev_poly_boxed 984 ++ print $ O.lev_poly_b B.lev_poly B.lev_poly_boxed 985 ++ print $ O.lev_poly_b B.lev_poly O.lev_poly_boxed 986 ++ print $ O.lev_poly_b O.lev_poly B.lev_poly_boxed 987 ++ print $ O.lev_poly_b O.lev_poly O.lev_poly_boxed 988 ++ ++ -- sums ++ testX "sum1a" ++ B.sum1_a O.sum1_a ++ B.sum1 O.sum1 ++ (\f -> f 0 1 "23" True) ++ ++ testX "sum1b" ++ B.sum1_a O.sum1_a ++ B.sum1 O.sum1 ++ (\f -> f 1 1 "23" True) ++ ++ testX "sum2a" ++ B.sum2_a O.sum2_a ++ B.sum2 O.sum2 ++ (\f -> f 0 "sum2") ++ ++ testX "sum2b" ++ B.sum2_a O.sum2_a ++ B.sum2 O.sum2 ++ (\f -> f 1 "sum2") ++ ++ testX "sum2c" ++ B.sum2_a O.sum2_a ++ B.sum2 O.sum2 ++ (\f -> f 2 "sum2") ++ ++ testX "sum2d" ++ B.sum2_a O.sum2_a ++ B.sum2 O.sum2 ++ (\f -> f 3 "sum2") ++ ++ testX "sum2e" ++ B.sum2_a O.sum2_a ++ B.sum2 O.sum2 ++ (\f -> f 4 "sum2") ++ ++ ++ ++testX :: (Eq a, Show a) ++ => String -> (p -> t) -> (p -> t) -> p -> p -> (t -> a) -> IO () ++testX msg a1 a2 b1 b2 ap = ++ let (r:rs) = [ap (f g) | f <- [a1,a2], g <- [b1,b2]] ++ in putStrLn (msg ++ " " ++ (show $ all (==r) rs) ++ " " ++ show r) +diff --git a/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.stdout b/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.stdout +new file mode 100644 +index 0000000000..82619b86fc +--- /dev/null ++++ b/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.stdout +@@ -0,0 +1,43 @@ ++("x",1) ++tuple1 True 90053 ++tuple1_b ++tuple1_b ++tuple1_b ++tuple1_b ++tuple2p True (1234,1235,1236,1237) ++tuple2n True (7654,7653,7652,7651) ++tuple3 True (1000,1001,1002,1003,1004,1005,1006,1007,1008,1009,1010,1011) ++tuple4a True (2000.0,2001.0,2002.0,2003.0) ++tuple4b True ((3000.0,3001.0,3002.0,3003.0),(3004.0,3005.0,3006.0,3007.0),(3008.0,3009.0,3010.0,3011.0),(3012.0,3013.0,3014.0,3015.0),(3016.0,3017.0,3018.0,3019.0)) ++tuple4c True ((3000.0,3001.0,3002,3003),(3004.0,3005.0,3006,3007),(3008.0,3009.0,3010,3011),(3012.0,3013.0,3014,3015)) ++tuple5 True ((4000,4001,4002,4003),(4004,4005,4006,4007),(4008,4009,4010,4011),(4012,4013,4014,4015)) ++tuple6 True "(6006,(6006,(6006,())))" ++tuplev1 True True ++tuplev2 True True ++tuplev3 True 30001 ++tuplev4 True 40001 ++tuplev5 True 50001 ++tuplev6 True (601,602.0,603,604.0) ++(991,991,991,991,991,991,991,991,991,991,991,991) ++(992,992,992,992,992,992,992,992,992,992,992,992) ++(993,993,993,993,993,993,993,993,993,993,993,993) ++(994,994,994,994,994,994,994,994,994,994,994,994) ++(995,995,995,995,995,995,995,995,995,995,995,995) ++(996,996,996,996,996,996,996,996,996,996,996,996) ++(997,997,997,997,997,997,997,997,997,997,997,997) ++(998,998,998,998,998,998,998,998,998,998,998,998) ++(981,981,981,981,981,981,981,981,981,981,981,981) ++(982,982,982,982,982,982,982,982,982,982,982,982) ++(983,983,983,983,983,983,983,983,983,983,983,983) ++(984,984,984,984,984,984,984,984,984,984,984,984) ++(985,985,985,985,985,985,985,985,985,985,985,985) ++(986,986,986,986,986,986,986,986,986,986,986,986) ++(987,987,987,987,987,987,987,987,987,987,987,987) ++(988,988,988,988,988,988,988,988,988,988,988,988) ++sum1a True Left (1,"23") ++sum1b True Right True ++sum2a True "(\"sum2\",\"sum2\",\"sum2\",\"sum2\")" ++sum2b True "(\"sum2\",\"sum2\")" ++sum2c True "(# #)" ++sum2d True "3" ++sum2e True "4#" +diff --git a/testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T b/testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T +new file mode 100644 +index 0000000000..4166c82f7f +--- /dev/null ++++ b/testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T +@@ -0,0 +1,10 @@ ++test('UnboxedTuples', ++ [ extra_files(['Obj.hs', 'ByteCode.hs', 'Common.hs-incl']), ++ req_interp, ++ extra_ways(['ghci']), ++ when(config.have_ext_interp, extra_ways(['ghci', 'ghci-ext'])), ++ when(config.have_ext_interp and config.have_profiling, extra_ways(['ghci', 'ghci-ext', 'ghci-ext-prof'])) ++ ], ++ compile_and_run, ++ [''] ++ ) diff --git a/release.nix b/release.nix index ca3de7a550..64dd95dab2 100644 --- a/release.nix +++ b/release.nix @@ -15,8 +15,8 @@ let # added here will also included without aggregation, making it easier # to find a failing test. Keep in mind though that adding too many # of these will slow down eval times. - linux = allJobs.R2009.ghc8104.linux.native or {}; - darwin = allJobs.R2009.ghc8104.darwin.native or {}; + linux = allJobs.R2009.ghc8105.linux.native or {}; + darwin = allJobs.R2009.ghc8105.darwin.native or {}; }; names = x: lib.filter (n: n != "recurseForDerivations" && n != "meta") (builtins.attrNames x); From 88a1752907c759cc2e0b4a90e4784893f326f031 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 8 Jun 2021 19:26:23 +1200 Subject: [PATCH 29/32] ifdLevel 0 --- release.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/release.nix b/release.nix index 64dd95dab2..110394a8d7 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,7 @@ # 'supportedSystems' restricts the set of systems that we will evaluate for. Useful when you're evaluating # on a machine with e.g. no way to build the Darwin IFDs you need! { supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ] -, ifdLevel ? 1 +, ifdLevel ? 0 , checkMaterialization ? false }: let From 5e8637d02fa67ae74a26c112a161b435624bc1f7 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 9 Jun 2021 00:32:24 +1200 Subject: [PATCH 30/32] Some of the materialized files for ghc 8.10.5 --- .../ghc-boot-packages-nix/ghc8105/base.nix | 43 ++ .../ghc8105/bytestring.nix | 35 ++ .../ghc8105/ghc-boot.nix | 39 ++ .../ghc8105/ghc-heap.nix | 35 ++ .../ghc8105/ghc-prim.nix | 43 ++ .../ghc-boot-packages-nix/ghc8105/ghc.nix | 62 ++ .../ghc-boot-packages-nix/ghc8105/ghci.nix | 45 ++ .../ghc-boot-packages-nix/ghc8105/hpc.nix | 38 ++ .../ghc8105/integer-gmp.nix | 33 + .../ghc8105/iserv-proxy.nix | 45 ++ .../ghc-boot-packages-nix/ghc8105/iserv.nix | 42 ++ .../ghc8105/libiserv.nix | 42 ++ .../ghc8105/remote-iserv.nix | 36 ++ .../ghc8105/template-haskell.nix | 36 ++ .../default/ghc8105/.plan.nix/bytestring.nix | 71 +++ .../default/ghc8105/.plan.nix/ghc-boot.nix | 60 ++ .../default/ghc8105/.plan.nix/ghc.nix | 586 ++++++++++++++++++ .../default/ghc8105/.plan.nix/ghci.nix | 71 +++ .../default/ghc8105/.plan.nix/hpc.nix | 52 ++ .../default/ghc8105/.plan.nix/iserv-proxy.nix | 55 ++ .../default/ghc8105/.plan.nix/iserv.nix | 54 ++ .../default/ghc8105/.plan.nix/libiserv.nix | 58 ++ .../ghc8105/.plan.nix/remote-iserv.nix | 46 ++ .../default/ghc8105/default.nix | 91 +++ .../cabal-install/.plan.nix/cabal-install.nix | 361 +++++++++++ .../ghc8105/cabal-install/default.nix | 128 ++++ .../nix-tools/.plan.nix/hackage-db.nix | 100 +++ .../ghc8105/nix-tools/.plan.nix/nix-tools.nix | 233 +++++++ materialized/ghc8105/nix-tools/default.nix | 362 +++++++++++ 29 files changed, 2902 insertions(+) create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/base.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/bytestring.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/ghc-boot.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/ghc-heap.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/ghc-prim.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/ghc.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/ghci.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/hpc.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/integer-gmp.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/iserv-proxy.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/iserv.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/libiserv.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/remote-iserv.nix create mode 100644 materialized/ghc-boot-packages-nix/ghc8105/template-haskell.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/bytestring.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc-boot.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghci.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/hpc.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv-proxy.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/libiserv.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/.plan.nix/remote-iserv.nix create mode 100644 materialized/ghc-extra-projects/default/ghc8105/default.nix create mode 100644 materialized/ghc8105/cabal-install/.plan.nix/cabal-install.nix create mode 100644 materialized/ghc8105/cabal-install/default.nix create mode 100644 materialized/ghc8105/nix-tools/.plan.nix/hackage-db.nix create mode 100644 materialized/ghc8105/nix-tools/.plan.nix/nix-tools.nix create mode 100644 materialized/ghc8105/nix-tools/default.nix diff --git a/materialized/ghc-boot-packages-nix/ghc8105/base.nix b/materialized/ghc-boot-packages-nix/ghc8105/base.nix new file mode 100644 index 0000000000..f9330e55d4 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/base.nix @@ -0,0 +1,43 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { integer-simple = false; integer-gmp = false; }; + package = { + specVersion = "3.0"; + identifier = { name = "base"; version = "4.14.2.0"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "libraries@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "Basic libraries"; + description = "This package contains the Standard Haskell \"Prelude\" and its support libraries,\nand a large collection of useful libraries ranging from data\nstructures to parsing combinators and debugging utilities."; + buildType = "Configure"; + }; + components = { + "library" = { + depends = (([ + (hsPkgs."rts" or (errorHandler.buildDepError "rts")) + (hsPkgs."ghc-prim" or (errorHandler.buildDepError "ghc-prim")) + ] ++ (pkgs.lib).optional (!(flags.integer-gmp && !flags.integer-simple || !flags.integer-gmp && flags.integer-simple)) (hsPkgs."invalid-cabal-flag-settings" or (errorHandler.buildDepError "invalid-cabal-flag-settings"))) ++ (pkgs.lib).optional (flags.integer-simple) (hsPkgs."integer-simple" or (errorHandler.buildDepError "integer-simple"))) ++ (pkgs.lib).optional (flags.integer-gmp) (hsPkgs."integer-gmp" or (errorHandler.buildDepError "integer-gmp")); + libs = (pkgs.lib).optionals (system.isWindows) [ + (pkgs."wsock32" or (errorHandler.sysDepError "wsock32")) + (pkgs."user32" or (errorHandler.sysDepError "user32")) + (pkgs."shell32" or (errorHandler.sysDepError "shell32")) + (pkgs."msvcrt" or (errorHandler.sysDepError "msvcrt")) + (pkgs."mingw32" or (errorHandler.sysDepError "mingw32")) + (pkgs."mingwex" or (errorHandler.sysDepError "mingwex")) + (pkgs."shlwapi" or (errorHandler.sysDepError "shlwapi")) + ]; + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/bytestring.nix b/materialized/ghc-boot-packages-nix/ghc8105/bytestring.nix new file mode 100644 index 0000000000..0e5d3f2974 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/bytestring.nix @@ -0,0 +1,35 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { integer-simple = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "bytestring"; version = "0.10.12.0"; }; + license = "BSD-3-Clause"; + copyright = "Copyright (c) Don Stewart 2005-2009,\n(c) Duncan Coutts 2006-2015,\n(c) David Roundy 2003-2005,\n(c) Jasper Van der Jeugt 2010,\n(c) Simon Meier 2010-2013."; + maintainer = "Duncan Coutts "; + author = "Don Stewart,\nDuncan Coutts"; + homepage = "https://github.com/haskell/bytestring"; + url = ""; + synopsis = "Fast, compact, strict and lazy byte strings with a list interface"; + description = "An efficient compact, immutable byte string type (both strict and lazy)\nsuitable for binary or 8-bit character data.\n\nThe 'ByteString' type represents sequences of bytes or 8-bit characters.\nIt is suitable for high performance use, both in terms of large data\nquantities, or high speed requirements. The 'ByteString' functions follow\nthe same style as Haskell\\'s ordinary lists, so it is easy to convert code\nfrom using 'String' to 'ByteString'.\n\nTwo 'ByteString' variants are provided:\n\n* Strict 'ByteString's keep the string as a single large array. This\nmakes them convenient for passing data between C and Haskell.\n\n* Lazy 'ByteString's use a lazy list of strict chunks which makes it\nsuitable for I\\/O streaming tasks.\n\nThe @Char8@ modules provide a character-based view of the same\nunderlying 'ByteString' types. This makes it convenient to handle mixed\nbinary and 8-bit character content (which is common in many file formats\nand network protocols).\n\nThe 'Builder' module provides an efficient way to build up 'ByteString's\nin an ad-hoc way by repeated concatenation. This is ideal for fast\nserialisation or pretty printing.\n\nThere is also a 'ShortByteString' type which has a lower memory overhead\nand can can be converted to or from a 'ByteString', but supports very few\nother operations. It is suitable for keeping many short strings in memory.\n\n'ByteString's are not designed for Unicode. For Unicode strings you should\nuse the 'Text' type from the @text@ package.\n\nThese modules are intended to be imported qualified, to avoid name clashes\nwith \"Prelude\" functions, e.g.\n\n> import qualified Data.ByteString as BS"; + buildType = "Simple"; + }; + components = { + "library" = { + depends = (([ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."ghc-prim" or (errorHandler.buildDepError "ghc-prim")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + ] ++ (pkgs.lib).optional (compiler.isGhc && (compiler.version).ge "8.11") (hsPkgs."ghc-bignum" or (errorHandler.buildDepError "ghc-bignum"))) ++ (pkgs.lib).optionals (compiler.isGhc && (compiler.version).ge "6.11" && (compiler.isGhc && (compiler.version).lt "8.11")) ((pkgs.lib).optional (!flags.integer-simple) (hsPkgs."integer-gmp" or (errorHandler.buildDepError "integer-gmp")))) ++ (pkgs.lib).optional (compiler.isGhc && (compiler.version).ge "6.9" && (compiler.isGhc && (compiler.version).lt "6.11")) (hsPkgs."integer" or (errorHandler.buildDepError "integer")); + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/ghc-boot.nix b/materialized/ghc-boot-packages-nix/ghc8105/ghc-boot.nix new file mode 100644 index 0000000000..78b2ff1630 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/ghc-boot.nix @@ -0,0 +1,39 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.22"; + identifier = { name = "ghc-boot"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "ghc-devs@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "Shared functionality between GHC and its boot libraries"; + description = "This library is shared between GHC, ghc-pkg, and other boot\nlibraries.\n\nA note about \"GHC.PackageDb\": it only deals with the subset of\nthe package database that the compiler cares about: modules\npaths etc and not package metadata like description, authors\netc. It is thus not a library interface to ghc-pkg and is *not*\nsuitable for modifying GHC package databases.\n\nThe package database format and this library are constructed in\nsuch a way that while ghc-pkg depends on Cabal, the GHC library\nand program do not have to depend on Cabal."; + buildType = "Simple"; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."ghc-boot-th" or (errorHandler.buildDepError "ghc-boot-th")) + ]; + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/ghc-heap.nix b/materialized/ghc-boot-packages-nix/ghc8105/ghc-heap.nix new file mode 100644 index 0000000000..0179fb2a8a --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/ghc-heap.nix @@ -0,0 +1,35 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "3.0"; + identifier = { name = "ghc-heap"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "libraries@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "Functions for walking GHC's heap"; + description = "This package provides functions for walking the GHC heap data structures\nand retrieving information about those data structures."; + buildType = "Simple"; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."ghc-prim" or (errorHandler.buildDepError "ghc-prim")) + (hsPkgs."rts" or (errorHandler.buildDepError "rts")) + ]; + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/ghc-prim.nix b/materialized/ghc-boot-packages-nix/ghc8105/ghc-prim.nix new file mode 100644 index 0000000000..21ab4ad3ce --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/ghc-prim.nix @@ -0,0 +1,43 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "2.2"; + identifier = { name = "ghc-prim"; version = "0.6.1"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "libraries@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "GHC primitives"; + description = "This package contains the primitive types and operations supplied by GHC."; + buildType = "Custom"; + setup-depends = [ + (hsPkgs.buildPackages.base or (pkgs.buildPackages.base or (errorHandler.setupDepError "base"))) + (hsPkgs.buildPackages.Cabal or (pkgs.buildPackages.Cabal or (errorHandler.setupDepError "Cabal"))) + ]; + }; + components = { + "library" = { + depends = [ (hsPkgs."rts" or (errorHandler.buildDepError "rts")) ]; + libs = (pkgs.lib).optionals (system.isWindows) [ + (pkgs."user32" or (errorHandler.sysDepError "user32")) + (pkgs."mingw32" or (errorHandler.sysDepError "mingw32")) + (pkgs."mingwex" or (errorHandler.sysDepError "mingwex")) + ] ++ (pkgs.lib).optionals (system.isLinux) [ + (pkgs."c" or (errorHandler.sysDepError "c")) + (pkgs."m" or (errorHandler.sysDepError "m")) + ]; + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/ghc.nix b/materialized/ghc-boot-packages-nix/ghc8105/ghc.nix new file mode 100644 index 0000000000..cbcc9c6996 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/ghc.nix @@ -0,0 +1,62 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { + ghci = false; + stage1 = false; + stage2 = false; + stage3 = false; + terminfo = true; + integer-simple = false; + integer-gmp = false; + dynamic-system-linker = true; + }; + package = { + specVersion = "1.10"; + identifier = { name = "ghc"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "glasgow-haskell-users@haskell.org"; + author = "The GHC Team"; + homepage = "http://www.haskell.org/ghc/"; + url = ""; + synopsis = "The GHC API"; + description = "GHC's functionality can be useful for more things than just\ncompiling Haskell programs. Important use cases are programs\nthat analyse (and perhaps transform) Haskell code. Others\ninclude loading Haskell code dynamically in a GHCi-like manner.\nFor this reason, a lot of GHC's functionality is made available\nthrough this package."; + buildType = "Simple"; + }; + components = { + "library" = { + depends = ((([ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."process" or (errorHandler.buildDepError "process")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."template-haskell" or (errorHandler.buildDepError "template-haskell")) + (hsPkgs."hpc" or (errorHandler.buildDepError "hpc")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + (hsPkgs."ghc-boot" or (errorHandler.buildDepError "ghc-boot")) + (hsPkgs."ghc-boot-th" or (errorHandler.buildDepError "ghc-boot-th")) + (hsPkgs."ghc-heap" or (errorHandler.buildDepError "ghc-heap")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + ] ++ (if system.isWindows + then [ (hsPkgs."Win32" or (errorHandler.buildDepError "Win32")) ] + else [ + (hsPkgs."unix" or (errorHandler.buildDepError "unix")) + ] ++ (pkgs.lib).optional (flags.terminfo) (hsPkgs."terminfo" or (errorHandler.buildDepError "terminfo")))) ++ (pkgs.lib).optional (flags.integer-gmp && flags.integer-simple) (hsPkgs."invalid-cabal-flag-settings" or (errorHandler.buildDepError "invalid-cabal-flag-settings"))) ++ (pkgs.lib).optional (flags.integer-gmp) (hsPkgs."integer-gmp" or (errorHandler.buildDepError "integer-gmp"))) ++ (pkgs.lib).optional (flags.integer-simple) (hsPkgs."integer-simple" or (errorHandler.buildDepError "integer-simple")); + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/ghci.nix b/materialized/ghc-boot-packages-nix/ghc8105/ghci.nix new file mode 100644 index 0000000000..7899ac1cf4 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/ghci.nix @@ -0,0 +1,45 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { ghci = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "ghci"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "ghc-devs@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "The library supporting GHC's interactive interpreter"; + description = "This library offers interfaces which mediate interactions between the\n@ghci@ interactive shell and @iserv@, GHC's out-of-process interpreter\nbackend."; + buildType = "Simple"; + }; + components = { + "library" = { + depends = [ + (hsPkgs."rts" or (errorHandler.buildDepError "rts")) + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."ghc-boot" or (errorHandler.buildDepError "ghc-boot")) + (hsPkgs."ghc-boot-th" or (errorHandler.buildDepError "ghc-boot-th")) + (hsPkgs."ghc-heap" or (errorHandler.buildDepError "ghc-heap")) + (hsPkgs."template-haskell" or (errorHandler.buildDepError "template-haskell")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + ] ++ (pkgs.lib).optional (!system.isWindows) (hsPkgs."unix" or (errorHandler.buildDepError "unix")); + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/hpc.nix b/materialized/ghc-boot-packages-nix/ghc8105/hpc.nix new file mode 100644 index 0000000000..ddd3aa6beb --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/hpc.nix @@ -0,0 +1,38 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "hpc"; version = "0.6.1.0"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "ghc-devs@haskell.org"; + author = "Andy Gill"; + homepage = ""; + url = ""; + synopsis = "Code Coverage Library for Haskell"; + description = "This package provides the code coverage library for Haskell.\n\nSee for more\ninformation."; + buildType = "Simple"; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) + ]; + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/integer-gmp.nix b/materialized/ghc-boot-packages-nix/ghc8105/integer-gmp.nix new file mode 100644 index 0000000000..fad07c20cd --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/integer-gmp.nix @@ -0,0 +1,33 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "2.0"; + identifier = { name = "integer-gmp"; version = "1.0.3.0"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "hvr@gnu.org"; + author = "Herbert Valerio Riedel"; + homepage = ""; + url = ""; + synopsis = "Integer library based on GMP"; + description = "This package provides the low-level implementation of the standard\n'Integer' type based on the\n.\n\nThis package provides access to the internal representation of\n'Integer' as well as primitive operations with no proper error\nhandling, and should only be used directly with the utmost care."; + buildType = "Configure"; + }; + components = { + "library" = { + depends = [ + (hsPkgs."ghc-prim" or (errorHandler.buildDepError "ghc-prim")) + ]; + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/iserv-proxy.nix b/materialized/ghc-boot-packages-nix/ghc8105/iserv-proxy.nix new file mode 100644 index 0000000000..5dd9b12657 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/iserv-proxy.nix @@ -0,0 +1,45 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "iserv-proxy"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "XXX"; + author = "XXX"; + homepage = ""; + url = ""; + synopsis = "iserv allows GHC to delegate Tempalte Haskell computations"; + description = "GHC can be provided with a path to the iserv binary with\n@-pgmi=/path/to/iserv-bin@, and will in combination with\n@-fexternal-interpreter@, compile Template Haskell though the\n@iserv-bin@ delegate. This is very similar to how ghcjs has been\ncompiling Template Haskell, by spawning a separate delegate (so\ncalled runner on the javascript vm) and evaluating the splices\nthere.\n\niserv can also be used in combination with cross compilation. For\nthis, the @iserv-proxy@ needs to be built on the host, targeting the\nhost (as it is running on the host). @cabal install -flibrary\n-fproxy@ will yield the proxy.\n\nUsing the cabal for the target @arch-platform-target-cabal install\n-flibrary@ will build the required library that contains the ffi\n@startSlave@ function, which needs to be invoked on the target\n(e.g. in an iOS application) to start the remote iserv slave.\n\ncalling the GHC cross compiler with @-fexternal-interpreter\n-pgmi=\$HOME/.cabal/bin/iserv-proxy -opti\\ -opti\\@\nwill cause it to compile Template Haskell via the remote at \\.\n\nThus to get cross compilation with Template Haskell follow the\nfollowing receipt:\n\n* compile the iserv library for your target\n\n> iserv \$ arch-platform-target-cabal install -flibrary\n\n* setup an application for your target that calls the\n* startSlave function. This could be either haskell or your\n* targets ffi capable language, if needed.\n\n> void startSlave(false /* verbose */, 5000 /* port */,\n> \"/path/to/storagelocation/on/target\");\n\n* build the iserv-proxy\n\n> iserv \$ cabal install -flibrary -fproxy\n* Start your iserv-slave app on your target running on say @10.0.0.1:5000@\n* compiler your sources with -fexternal-interpreter and the proxy\n\n> project \$ arch-platform-target-ghc ModuleContainingTH.hs \\\n> -fexternal-interpreter \\\n> -pgmi=\$HOME/.cabal/bin/iserv-proxy \\\n> -opti10.0.0.1 -opti5000\n\nShould something not work as expected, provide @-opti-v@ for verbose\nlogging of the @iserv-proxy@."; + buildType = "Simple"; + }; + components = { + exes = { + "iserv-proxy" = { + depends = [ + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."network" or (errorHandler.buildDepError "network")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + (hsPkgs."libiserv" or (errorHandler.buildDepError "libiserv")) + ]; + buildable = true; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/iserv.nix b/materialized/ghc-boot-packages-nix/ghc8105/iserv.nix new file mode 100644 index 0000000000..218d5fbd73 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/iserv.nix @@ -0,0 +1,42 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "iserv"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "XXX"; + author = "XXX"; + homepage = ""; + url = ""; + synopsis = "iserv allows GHC to delegate Template Haskell computations"; + description = "GHC can be provided with a path to the iserv binary with\n@-pgmi=/path/to/iserv-bin@, and will in combination with\n@-fexternal-interpreter@, compile Template Haskell though the\n@iserv-bin@ delegate. This is very similar to how ghcjs has been\ncompiling Template Haskell, by spawning a separate delegate (so\ncalled runner on the javascript vm) and evaluating the splices\nthere.\n\nTo use iserv with cross compilers, please see @libraries/libiserv@\nand @utils/iserv-proxy@."; + buildType = "Simple"; + }; + components = { + exes = { + "iserv" = { + depends = [ + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + (hsPkgs."libiserv" or (errorHandler.buildDepError "libiserv")) + ] ++ (pkgs.lib).optional (!system.isWindows) (hsPkgs."unix" or (errorHandler.buildDepError "unix")); + buildable = true; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/libiserv.nix b/materialized/ghc-boot-packages-nix/ghc8105/libiserv.nix new file mode 100644 index 0000000000..157d7185df --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/libiserv.nix @@ -0,0 +1,42 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { network = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "libiserv"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "XXX"; + author = "XXX"; + homepage = ""; + url = ""; + synopsis = "Provides shared functionality between iserv and iserv-proxy"; + description = ""; + buildType = "Simple"; + }; + components = { + "library" = { + depends = ([ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + ] ++ (pkgs.lib).optionals (flags.network) [ + (hsPkgs."network" or (errorHandler.buildDepError "network")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + ]) ++ (pkgs.lib).optional (!system.isWindows) (hsPkgs."unix" or (errorHandler.buildDepError "unix")); + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/remote-iserv.nix b/materialized/ghc-boot-packages-nix/ghc8105/remote-iserv.nix new file mode 100644 index 0000000000..77a43504a0 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/remote-iserv.nix @@ -0,0 +1,36 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "remote-iserv"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "Moritz Angermann "; + author = "Moritz Angermann "; + homepage = ""; + url = ""; + synopsis = "iserv allows GHC to delegate Tempalte Haskell computations"; + description = "This is a very simple remote runner for iserv, to be used together\nwith iserv-proxy. The foundamental idea is that this this wrapper\nstarts running libiserv on a given port to which iserv-proxy will\nthen connect."; + buildType = "Simple"; + }; + components = { + exes = { + "remote-iserv" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."libiserv" or (errorHandler.buildDepError "libiserv")) + ]; + buildable = true; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-boot-packages-nix/ghc8105/template-haskell.nix b/materialized/ghc-boot-packages-nix/ghc8105/template-haskell.nix new file mode 100644 index 0000000000..cb428418b3 --- /dev/null +++ b/materialized/ghc-boot-packages-nix/ghc8105/template-haskell.nix @@ -0,0 +1,36 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "template-haskell"; version = "2.16.0.0"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "libraries@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "Support library for Template Haskell"; + description = "This package provides modules containing facilities for manipulating\nHaskell source code using Template Haskell.\n\nSee for more\ninformation."; + buildType = "Simple"; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."ghc-boot-th" or (errorHandler.buildDepError "ghc-boot-th")) + (hsPkgs."ghc-prim" or (errorHandler.buildDepError "ghc-prim")) + (hsPkgs."pretty" or (errorHandler.buildDepError "pretty")) + ]; + buildable = true; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ./.; } diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/bytestring.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/bytestring.nix new file mode 100644 index 0000000000..639068f756 --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/bytestring.nix @@ -0,0 +1,71 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { integer-simple = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "bytestring"; version = "0.10.12.0"; }; + license = "BSD-3-Clause"; + copyright = "Copyright (c) Don Stewart 2005-2009,\n(c) Duncan Coutts 2006-2015,\n(c) David Roundy 2003-2005,\n(c) Jasper Van der Jeugt 2010,\n(c) Simon Meier 2010-2013."; + maintainer = "Duncan Coutts "; + author = "Don Stewart,\nDuncan Coutts"; + homepage = "https://github.com/haskell/bytestring"; + url = ""; + synopsis = "Fast, compact, strict and lazy byte strings with a list interface"; + description = "An efficient compact, immutable byte string type (both strict and lazy)\nsuitable for binary or 8-bit character data.\n\nThe 'ByteString' type represents sequences of bytes or 8-bit characters.\nIt is suitable for high performance use, both in terms of large data\nquantities, or high speed requirements. The 'ByteString' functions follow\nthe same style as Haskell\\'s ordinary lists, so it is easy to convert code\nfrom using 'String' to 'ByteString'.\n\nTwo 'ByteString' variants are provided:\n\n* Strict 'ByteString's keep the string as a single large array. This\nmakes them convenient for passing data between C and Haskell.\n\n* Lazy 'ByteString's use a lazy list of strict chunks which makes it\nsuitable for I\\/O streaming tasks.\n\nThe @Char8@ modules provide a character-based view of the same\nunderlying 'ByteString' types. This makes it convenient to handle mixed\nbinary and 8-bit character content (which is common in many file formats\nand network protocols).\n\nThe 'Builder' module provides an efficient way to build up 'ByteString's\nin an ad-hoc way by repeated concatenation. This is ideal for fast\nserialisation or pretty printing.\n\nThere is also a 'ShortByteString' type which has a lower memory overhead\nand can can be converted to or from a 'ByteString', but supports very few\nother operations. It is suitable for keeping many short strings in memory.\n\n'ByteString's are not designed for Unicode. For Unicode strings you should\nuse the 'Text' type from the @text@ package.\n\nThese modules are intended to be imported qualified, to avoid name clashes\nwith \"Prelude\" functions, e.g.\n\n> import qualified Data.ByteString as BS"; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = [ "README.md" "Changelog.md" ]; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = (([ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."ghc-prim" or (errorHandler.buildDepError "ghc-prim")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + ] ++ (pkgs.lib).optional (compiler.isGhc && (compiler.version).ge "8.11") (hsPkgs."ghc-bignum" or (errorHandler.buildDepError "ghc-bignum"))) ++ (pkgs.lib).optionals (compiler.isGhc && (compiler.version).ge "6.11" && (compiler.isGhc && (compiler.version).lt "8.11")) ((pkgs.lib).optional (!flags.integer-simple) (hsPkgs."integer-gmp" or (errorHandler.buildDepError "integer-gmp")))) ++ (pkgs.lib).optional (compiler.isGhc && (compiler.version).ge "6.9" && (compiler.isGhc && (compiler.version).lt "6.11")) (hsPkgs."integer" or (errorHandler.buildDepError "integer")); + buildable = true; + modules = [ + "Data/ByteString/Builder/ASCII" + "Data/ByteString/Builder/Prim/Binary" + "Data/ByteString/Builder/Prim/ASCII" + "Data/ByteString/Builder/Prim/Internal/Floating" + "Data/ByteString/Builder/Prim/Internal/UncheckedShifts" + "Data/ByteString/Builder/Prim/Internal/Base16" + "Data/ByteString" + "Data/ByteString/Char8" + "Data/ByteString/Unsafe" + "Data/ByteString/Internal" + "Data/ByteString/Lazy" + "Data/ByteString/Lazy/Char8" + "Data/ByteString/Lazy/Internal" + "Data/ByteString/Short" + "Data/ByteString/Short/Internal" + "Data/ByteString/Builder" + "Data/ByteString/Builder/Extra" + "Data/ByteString/Builder/Prim" + "Data/ByteString/Builder/Internal" + "Data/ByteString/Builder/Prim/Internal" + "Data/ByteString/Lazy/Builder" + "Data/ByteString/Lazy/Builder/Extras" + "Data/ByteString/Lazy/Builder/ASCII" + ]; + cSources = [ "cbits/fpstring.c" "cbits/itoa.c" ]; + includeDirs = [ "include" ]; + includes = [ "fpstring.h" ]; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../libraries/bytestring; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc-boot.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc-boot.nix new file mode 100644 index 0000000000..9e286c0b57 --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc-boot.nix @@ -0,0 +1,60 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.22"; + identifier = { name = "ghc-boot"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "ghc-devs@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "Shared functionality between GHC and its boot libraries"; + description = "This library is shared between GHC, ghc-pkg, and other boot\nlibraries.\n\nA note about \"GHC.PackageDb\": it only deals with the subset of\nthe package database that the compiler cares about: modules\npaths etc and not package metadata like description, authors\netc. It is thus not a library interface to ghc-pkg and is *not*\nsuitable for modifying GHC package databases.\n\nThe package database format and this library are constructed in\nsuch a way that while ghc-pkg depends on Cabal, the GHC library\nand program do not have to depend on Cabal."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = []; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."ghc-boot-th" or (errorHandler.buildDepError "ghc-boot-th")) + ]; + buildable = true; + modules = [ + "GHC/BaseDir" + "GHC/LanguageExtensions" + "GHC/PackageDb" + "GHC/Serialized" + "GHC/ForeignSrcLang" + "GHC/HandleEncoding" + "GHC/Platform" + "GHC/Platform/Host" + "GHC/Settings" + "GHC/UniqueSubdir" + "GHC/Version" + ]; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../libraries/ghc-boot; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc.nix new file mode 100644 index 0000000000..30e4016325 --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghc.nix @@ -0,0 +1,586 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { + ghci = false; + stage1 = false; + stage2 = false; + stage3 = false; + terminfo = true; + integer-simple = false; + integer-gmp = false; + dynamic-system-linker = true; + }; + package = { + specVersion = "1.10"; + identifier = { name = "ghc"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "glasgow-haskell-users@haskell.org"; + author = "The GHC Team"; + homepage = "http://www.haskell.org/ghc/"; + url = ""; + synopsis = "The GHC API"; + description = "GHC's functionality can be useful for more things than just\ncompiling Haskell programs. Important use cases are programs\nthat analyse (and perhaps transform) Haskell code. Others\ninclude loading Haskell code dynamically in a GHCi-like manner.\nFor this reason, a lot of GHC's functionality is made available\nthrough this package."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = []; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = ((([ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."process" or (errorHandler.buildDepError "process")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."template-haskell" or (errorHandler.buildDepError "template-haskell")) + (hsPkgs."hpc" or (errorHandler.buildDepError "hpc")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + (hsPkgs."ghc-boot" or (errorHandler.buildDepError "ghc-boot")) + (hsPkgs."ghc-boot-th" or (errorHandler.buildDepError "ghc-boot-th")) + (hsPkgs."ghc-heap" or (errorHandler.buildDepError "ghc-heap")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + ] ++ (if system.isWindows + then [ (hsPkgs."Win32" or (errorHandler.buildDepError "Win32")) ] + else [ + (hsPkgs."unix" or (errorHandler.buildDepError "unix")) + ] ++ (pkgs.lib).optional (flags.terminfo) (hsPkgs."terminfo" or (errorHandler.buildDepError "terminfo")))) ++ (pkgs.lib).optional (flags.integer-gmp && flags.integer-simple) (hsPkgs."invalid-cabal-flag-settings" or (errorHandler.buildDepError "invalid-cabal-flag-settings"))) ++ (pkgs.lib).optional (flags.integer-gmp) (hsPkgs."integer-gmp" or (errorHandler.buildDepError "integer-gmp"))) ++ (pkgs.lib).optional (flags.integer-simple) (hsPkgs."integer-simple" or (errorHandler.buildDepError "integer-simple")); + buildable = true; + modules = [ + "HieTypes" + "HieDebug" + "HieBin" + "HieUtils" + "HieAst" + "Ar" + "FileCleanup" + "DriverBkp" + "BkpSyn" + "NameShape" + "RnModIface" + "Avail" + "AsmUtils" + "BasicTypes" + "ConLike" + "DataCon" + "PatSyn" + "Demand" + "Debug" + "Exception" + "FieldLabel" + "GhcMonad" + "Hooks" + "Id" + "IdInfo" + "Predicate" + "Lexeme" + "Literal" + "Llvm" + "Llvm/AbsSyn" + "Llvm/MetaData" + "Llvm/PpLlvm" + "Llvm/Types" + "LlvmCodeGen" + "LlvmCodeGen/Base" + "LlvmCodeGen/CodeGen" + "LlvmCodeGen/Data" + "LlvmCodeGen/Ppr" + "LlvmCodeGen/Regs" + "LlvmMangler" + "MkId" + "Module" + "Name" + "NameEnv" + "NameSet" + "OccName" + "RdrName" + "NameCache" + "SrcLoc" + "UniqSupply" + "Unique" + "Var" + "VarEnv" + "VarSet" + "UnVarGraph" + "BlockId" + "CLabel" + "Cmm" + "CmmBuildInfoTables" + "CmmPipeline" + "CmmCallConv" + "CmmCommonBlockElim" + "CmmImplementSwitchPlans" + "CmmContFlowOpt" + "CmmExpr" + "CmmInfo" + "CmmLex" + "CmmLint" + "CmmLive" + "CmmMachOp" + "CmmMonad" + "CmmSwitch" + "CmmNode" + "CmmOpt" + "CmmParse" + "CmmProcPoint" + "CmmSink" + "CmmType" + "CmmUtils" + "CmmLayoutStack" + "CliOption" + "EnumSet" + "GhcNameVersion" + "FileSettings" + "MkGraph" + "PprBase" + "PprC" + "PprCmm" + "PprCmmDecl" + "PprCmmExpr" + "Bitmap" + "GHC/Platform/Regs" + "GHC/Platform/ARM" + "GHC/Platform/AArch64" + "GHC/Platform/NoRegs" + "GHC/Platform/PPC" + "GHC/Platform/S390X" + "GHC/Platform/SPARC" + "GHC/Platform/X86" + "GHC/Platform/X86_64" + "GHC/StgToCmm/CgUtils" + "GHC/StgToCmm" + "GHC/StgToCmm/Bind" + "GHC/StgToCmm/Closure" + "GHC/StgToCmm/DataCon" + "GHC/StgToCmm/Env" + "GHC/StgToCmm/Expr" + "GHC/StgToCmm/Foreign" + "GHC/StgToCmm/Heap" + "GHC/StgToCmm/Hpc" + "GHC/StgToCmm/ArgRep" + "GHC/StgToCmm/Layout" + "GHC/StgToCmm/Monad" + "GHC/StgToCmm/Prim" + "GHC/StgToCmm/Prof" + "GHC/StgToCmm/Ticky" + "GHC/StgToCmm/Utils" + "GHC/StgToCmm/ExtCode" + "SMRep" + "CoreArity" + "CoreFVs" + "CoreLint" + "CorePrep" + "CoreSubst" + "CoreOpt" + "CoreSyn" + "TrieMap" + "CoreTidy" + "CoreUnfold" + "CoreUtils" + "CoreMap" + "CoreSeq" + "CoreStats" + "MkCore" + "PprCore" + "GHC/HsToCore/PmCheck/Oracle" + "GHC/HsToCore/PmCheck/Ppr" + "GHC/HsToCore/PmCheck/Types" + "GHC/HsToCore/PmCheck" + "Coverage" + "Desugar" + "DsArrows" + "DsBinds" + "DsCCall" + "DsExpr" + "DsForeign" + "DsGRHSs" + "DsListComp" + "DsMonad" + "DsUsage" + "DsUtils" + "ExtractDocs" + "Match" + "MatchCon" + "MatchLit" + "GHC/Hs" + "GHC/Hs/Binds" + "GHC/Hs/Decls" + "GHC/Hs/Doc" + "GHC/Hs/Expr" + "GHC/Hs/ImpExp" + "GHC/Hs/Lit" + "GHC/Hs/PlaceHolder" + "GHC/Hs/Extension" + "GHC/Hs/Instances" + "GHC/Hs/Pat" + "GHC/Hs/Types" + "GHC/Hs/Utils" + "GHC/Hs/Dump" + "BinIface" + "BinFingerprint" + "BuildTyCl" + "IfaceEnv" + "IfaceSyn" + "IfaceType" + "ToIface" + "LoadIface" + "MkIface" + "TcIface" + "FlagChecker" + "Annotations" + "CmdLineParser" + "CodeOutput" + "Config" + "Constants" + "DriverMkDepend" + "DriverPhases" + "PipelineMonad" + "DriverPipeline" + "DynFlags" + "ErrUtils" + "Finder" + "GHC" + "GhcMake" + "GhcPlugins" + "GhcPrelude" + "DynamicLoading" + "HeaderInfo" + "HscMain" + "HscStats" + "HscTypes" + "InteractiveEval" + "InteractiveEvalTypes" + "PackageConfig" + "Packages" + "PlatformConstants" + "Plugins" + "TcPluginM" + "PprTyThing" + "Settings" + "StaticPtrTable" + "SysTools" + "SysTools/BaseDir" + "SysTools/Terminal" + "SysTools/ExtraObj" + "SysTools/Info" + "SysTools/Process" + "SysTools/Tasks" + "SysTools/Settings" + "Elf" + "TidyPgm" + "Ctype" + "HaddockUtils" + "Lexer" + "OptCoercion" + "Parser" + "RdrHsSyn" + "ApiAnnotation" + "ForeignCall" + "KnownUniques" + "PrelInfo" + "PrelNames" + "PrelRules" + "PrimOp" + "ToolSettings" + "TysPrim" + "TysWiredIn" + "CostCentre" + "CostCentreState" + "ProfInit" + "RnBinds" + "RnEnv" + "RnExpr" + "RnHsDoc" + "RnNames" + "RnPat" + "RnSource" + "RnSplice" + "RnTypes" + "RnFixity" + "RnUtils" + "RnUnbound" + "CoreMonad" + "CSE" + "FloatIn" + "FloatOut" + "LiberateCase" + "OccurAnal" + "SAT" + "SetLevels" + "SimplCore" + "SimplEnv" + "SimplMonad" + "SimplUtils" + "Simplify" + "SimplStg" + "StgStats" + "StgCse" + "StgLiftLams" + "StgLiftLams/Analysis" + "StgLiftLams/LiftM" + "StgLiftLams/Transformation" + "StgSubst" + "UnariseStg" + "RepType" + "Rules" + "SpecConstr" + "Specialise" + "CoreToStg" + "StgLint" + "StgSyn" + "StgFVs" + "CallArity" + "DmdAnal" + "Exitify" + "WorkWrap" + "WwLib" + "FamInst" + "ClsInst" + "Inst" + "TcAnnotations" + "TcArrows" + "TcBinds" + "TcSigs" + "TcClassDcl" + "TcDefaults" + "TcDeriv" + "TcDerivInfer" + "TcDerivUtils" + "TcEnv" + "TcExpr" + "TcForeign" + "TcGenDeriv" + "TcGenFunctor" + "TcGenGenerics" + "TcHsSyn" + "TcHsType" + "TcInstDcls" + "TcMType" + "TcValidity" + "TcMatches" + "TcPat" + "TcPatSyn" + "TcRnDriver" + "TcBackpack" + "TcRnExports" + "TcRnMonad" + "TcRnTypes" + "Constraint" + "TcOrigin" + "TcRules" + "TcSimplify" + "TcHoleErrors" + "TcHoleFitTypes" + "TcErrors" + "TcTyClsDecls" + "TcTyDecls" + "TcTypeable" + "TcType" + "TcEvidence" + "TcEvTerm" + "TcUnify" + "TcInteract" + "TcCanonical" + "TcFlatten" + "TcSMonad" + "TcTypeNats" + "TcSplice" + "Class" + "Coercion" + "DsMeta" + "THNames" + "FamInstEnv" + "FunDeps" + "InstEnv" + "TyCon" + "CoAxiom" + "Type" + "TyCoRep" + "TyCoFVs" + "TyCoSubst" + "TyCoPpr" + "TyCoTidy" + "Unify" + "Bag" + "Binary" + "BooleanFormula" + "BufWrite" + "Digraph" + "Encoding" + "FastFunctions" + "FastMutInt" + "FastString" + "FastStringEnv" + "Fingerprint" + "FiniteMap" + "FV" + "GraphBase" + "GraphColor" + "GraphOps" + "GraphPpr" + "IOEnv" + "Json" + "ListSetOps" + "Maybes" + "MonadUtils" + "OrdList" + "Outputable" + "Pair" + "Panic" + "PlainPanic" + "PprColour" + "Pretty" + "State" + "Stream" + "StringBuffer" + "UniqDFM" + "UniqDSet" + "UniqFM" + "UniqMap" + "UniqSet" + "Util" + "Hoopl/Block" + "Hoopl/Collections" + "Hoopl/Dataflow" + "Hoopl/Graph" + "Hoopl/Label" + "AsmCodeGen" + "TargetReg" + "NCGMonad" + "Instruction" + "BlockLayout" + "CFG" + "Dominators" + "Format" + "Reg" + "RegClass" + "PIC" + "CPrim" + "X86/Regs" + "X86/RegInfo" + "X86/Instr" + "X86/Cond" + "X86/Ppr" + "X86/CodeGen" + "PPC/Regs" + "PPC/RegInfo" + "PPC/Instr" + "PPC/Cond" + "PPC/Ppr" + "PPC/CodeGen" + "SPARC/Base" + "SPARC/Regs" + "SPARC/Imm" + "SPARC/AddrMode" + "SPARC/Cond" + "SPARC/Instr" + "SPARC/Stack" + "SPARC/ShortcutJump" + "SPARC/Ppr" + "SPARC/CodeGen" + "SPARC/CodeGen/Amode" + "SPARC/CodeGen/Base" + "SPARC/CodeGen/CondCode" + "SPARC/CodeGen/Gen32" + "SPARC/CodeGen/Gen64" + "SPARC/CodeGen/Sanity" + "SPARC/CodeGen/Expand" + "RegAlloc/Liveness" + "RegAlloc/Graph/Main" + "RegAlloc/Graph/Stats" + "RegAlloc/Graph/ArchBase" + "RegAlloc/Graph/ArchX86" + "RegAlloc/Graph/Coalesce" + "RegAlloc/Graph/Spill" + "RegAlloc/Graph/SpillClean" + "RegAlloc/Graph/SpillCost" + "RegAlloc/Graph/TrivColorable" + "RegAlloc/Linear/Main" + "RegAlloc/Linear/JoinToTargets" + "RegAlloc/Linear/State" + "RegAlloc/Linear/Stats" + "RegAlloc/Linear/FreeRegs" + "RegAlloc/Linear/StackMap" + "RegAlloc/Linear/Base" + "RegAlloc/Linear/X86/FreeRegs" + "RegAlloc/Linear/X86_64/FreeRegs" + "RegAlloc/Linear/PPC/FreeRegs" + "RegAlloc/Linear/SPARC/FreeRegs" + "Dwarf" + "Dwarf/Types" + "Dwarf/Constants" + "GHC/ThToHs" + "ByteCodeTypes" + "ByteCodeAsm" + "ByteCodeGen" + "ByteCodeInstr" + "ByteCodeItbls" + "ByteCodeLink" + "Debugger" + "LinkerTypes" + "Linker" + "RtClosureInspect" + "GHCi" + ]; + cSources = [ + "parser/cutils.c" + "ghci/keepCAFsForGHCi.c" + "cbits/genSym.c" + ]; + hsSourceDirs = [ + "." + "backpack" + "basicTypes" + "cmm" + "coreSyn" + "deSugar" + "ghci" + "iface" + "llvmGen" + "main" + "nativeGen" + "parser" + "prelude" + "profiling" + "rename" + "simplCore" + "simplStg" + "specialise" + "stgSyn" + "stranal" + "typecheck" + "types" + "utils" + "hieFile" + ]; + includeDirs = ([ + "." + "parser" + "utils" + ] ++ (pkgs.lib).optional (flags.ghci) "../rts/dist/build") ++ (if flags.stage1 + then [ "stage1" ] + else if flags.stage2 + then [ "stage2" ] + else (pkgs.lib).optional (flags.stage3) "stage2"); + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../compiler; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghci.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghci.nix new file mode 100644 index 0000000000..79d5340a96 --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/ghci.nix @@ -0,0 +1,71 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { ghci = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "ghci"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "ghc-devs@haskell.org"; + author = ""; + homepage = ""; + url = ""; + synopsis = "The library supporting GHC's interactive interpreter"; + description = "This library offers interfaces which mediate interactions between the\n@ghci@ interactive shell and @iserv@, GHC's out-of-process interpreter\nbackend."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = [ "changelog.md" ]; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = [ + (hsPkgs."rts" or (errorHandler.buildDepError "rts")) + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."ghc-boot" or (errorHandler.buildDepError "ghc-boot")) + (hsPkgs."ghc-boot-th" or (errorHandler.buildDepError "ghc-boot-th")) + (hsPkgs."ghc-heap" or (errorHandler.buildDepError "ghc-heap")) + (hsPkgs."template-haskell" or (errorHandler.buildDepError "template-haskell")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + ] ++ (pkgs.lib).optional (!system.isWindows) (hsPkgs."unix" or (errorHandler.buildDepError "unix")); + buildable = true; + modules = [ + "GHCi/BreakArray" + "GHCi/BinaryArray" + "GHCi/Message" + "GHCi/ResolvedBCO" + "GHCi/RemoteTypes" + "GHCi/FFI" + "GHCi/InfoTable" + "GHCi/StaticPtrTable" + "GHCi/TH/Binary" + "SizedSeq" + ] ++ (pkgs.lib).optionals (flags.ghci) [ + "GHCi/Run" + "GHCi/CreateBCO" + "GHCi/ObjLink" + "GHCi/Signals" + "GHCi/TH" + ]; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../libraries/ghci; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/hpc.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/hpc.nix new file mode 100644 index 0000000000..260c9b2b88 --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/hpc.nix @@ -0,0 +1,52 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "hpc"; version = "0.6.1.0"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "ghc-devs@haskell.org"; + author = "Andy Gill"; + homepage = ""; + url = ""; + synopsis = "Code Coverage Library for Haskell"; + description = "This package provides the code coverage library for Haskell.\n\nSee for more\ninformation."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = [ "changelog.md" ]; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) + ]; + buildable = true; + modules = [ + "Trace/Hpc/Util" + "Trace/Hpc/Mix" + "Trace/Hpc/Tix" + "Trace/Hpc/Reflect" + ]; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../libraries/hpc; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv-proxy.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv-proxy.nix new file mode 100644 index 0000000000..fe33fd4497 --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv-proxy.nix @@ -0,0 +1,55 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "iserv-proxy"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "XXX"; + author = "XXX"; + homepage = ""; + url = ""; + synopsis = "iserv allows GHC to delegate Tempalte Haskell computations"; + description = "GHC can be provided with a path to the iserv binary with\n@-pgmi=/path/to/iserv-bin@, and will in combination with\n@-fexternal-interpreter@, compile Template Haskell though the\n@iserv-bin@ delegate. This is very similar to how ghcjs has been\ncompiling Template Haskell, by spawning a separate delegate (so\ncalled runner on the javascript vm) and evaluating the splices\nthere.\n\niserv can also be used in combination with cross compilation. For\nthis, the @iserv-proxy@ needs to be built on the host, targeting the\nhost (as it is running on the host). @cabal install -flibrary\n-fproxy@ will yield the proxy.\n\nUsing the cabal for the target @arch-platform-target-cabal install\n-flibrary@ will build the required library that contains the ffi\n@startSlave@ function, which needs to be invoked on the target\n(e.g. in an iOS application) to start the remote iserv slave.\n\ncalling the GHC cross compiler with @-fexternal-interpreter\n-pgmi=\$HOME/.cabal/bin/iserv-proxy -opti\\ -opti\\@\nwill cause it to compile Template Haskell via the remote at \\.\n\nThus to get cross compilation with Template Haskell follow the\nfollowing receipt:\n\n* compile the iserv library for your target\n\n> iserv \$ arch-platform-target-cabal install -flibrary\n\n* setup an application for your target that calls the\n* startSlave function. This could be either haskell or your\n* targets ffi capable language, if needed.\n\n> void startSlave(false /* verbose */, 5000 /* port */,\n> \"/path/to/storagelocation/on/target\");\n\n* build the iserv-proxy\n\n> iserv \$ cabal install -flibrary -fproxy\n* Start your iserv-slave app on your target running on say @10.0.0.1:5000@\n* compiler your sources with -fexternal-interpreter and the proxy\n\n> project \$ arch-platform-target-ghc ModuleContainingTH.hs \\\n> -fexternal-interpreter \\\n> -pgmi=\$HOME/.cabal/bin/iserv-proxy \\\n> -opti10.0.0.1 -opti5000\n\nShould something not work as expected, provide @-opti-v@ for verbose\nlogging of the @iserv-proxy@."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = []; + dataDir = "."; + dataFiles = []; + extraSrcFiles = []; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + exes = { + "iserv-proxy" = { + depends = [ + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."network" or (errorHandler.buildDepError "network")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + (hsPkgs."libiserv" or (errorHandler.buildDepError "libiserv")) + ]; + buildable = true; + hsSourceDirs = [ "src" ]; + mainPath = [ "Main.hs" ]; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../utils/iserv-proxy; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv.nix new file mode 100644 index 0000000000..0b50830efa --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/iserv.nix @@ -0,0 +1,54 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "iserv"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "XXX"; + author = "XXX"; + homepage = ""; + url = ""; + synopsis = "iserv allows GHC to delegate Template Haskell computations"; + description = "GHC can be provided with a path to the iserv binary with\n@-pgmi=/path/to/iserv-bin@, and will in combination with\n@-fexternal-interpreter@, compile Template Haskell though the\n@iserv-bin@ delegate. This is very similar to how ghcjs has been\ncompiling Template Haskell, by spawning a separate delegate (so\ncalled runner on the javascript vm) and evaluating the splices\nthere.\n\nTo use iserv with cross compilers, please see @libraries/libiserv@\nand @utils/iserv-proxy@."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = []; + dataDir = "."; + dataFiles = []; + extraSrcFiles = []; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + exes = { + "iserv" = { + depends = [ + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + (hsPkgs."libiserv" or (errorHandler.buildDepError "libiserv")) + ] ++ (pkgs.lib).optional (!system.isWindows) (hsPkgs."unix" or (errorHandler.buildDepError "unix")); + buildable = true; + cSources = [ "cbits/iservmain.c" ]; + hsSourceDirs = [ "src" ]; + includeDirs = [ "." ]; + mainPath = [ "Main.hs" ] ++ [ "" ]; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../utils/iserv; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/libiserv.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/libiserv.nix new file mode 100644 index 0000000000..137b5d91af --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/libiserv.nix @@ -0,0 +1,58 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { network = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "libiserv"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "XXX"; + author = "XXX"; + homepage = ""; + url = ""; + synopsis = "Provides shared functionality between iserv and iserv-proxy"; + description = ""; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = []; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = ([ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."ghci" or (errorHandler.buildDepError "ghci")) + ] ++ (pkgs.lib).optionals (flags.network) [ + (hsPkgs."network" or (errorHandler.buildDepError "network")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + ]) ++ (pkgs.lib).optional (!system.isWindows) (hsPkgs."unix" or (errorHandler.buildDepError "unix")); + buildable = true; + modules = [ + "Lib" + "GHCi/Utils" + ] ++ (pkgs.lib).optionals (flags.network) [ + "Remote/Message" + "Remote/Slave" + ]; + hsSourceDirs = [ "src" ]; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../libraries/libiserv; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/remote-iserv.nix b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/remote-iserv.nix new file mode 100644 index 0000000000..366ee1fa3d --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/.plan.nix/remote-iserv.nix @@ -0,0 +1,46 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "remote-iserv"; version = "8.10.5"; }; + license = "BSD-3-Clause"; + copyright = "XXX"; + maintainer = "Moritz Angermann "; + author = "Moritz Angermann "; + homepage = ""; + url = ""; + synopsis = "iserv allows GHC to delegate Tempalte Haskell computations"; + description = "This is a very simple remote runner for iserv, to be used together\nwith iserv-proxy. The foundamental idea is that this this wrapper\nstarts running libiserv on a given port to which iserv-proxy will\nthen connect."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = []; + dataDir = "."; + dataFiles = []; + extraSrcFiles = []; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + exes = { + "remote-iserv" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."libiserv" or (errorHandler.buildDepError "libiserv")) + ]; + buildable = true; + hsSourceDirs = [ "src" ]; + mainPath = [ "Cli.hs" ]; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../utils/remote-iserv; } \ No newline at end of file diff --git a/materialized/ghc-extra-projects/default/ghc8105/default.nix b/materialized/ghc-extra-projects/default/ghc8105/default.nix new file mode 100644 index 0000000000..62755947c9 --- /dev/null +++ b/materialized/ghc-extra-projects/default/ghc8105/default.nix @@ -0,0 +1,91 @@ +{ + pkgs = hackage: + { + packages = { + "binary".revision = (((hackage."binary")."0.8.8.0").revisions).default; + "ghc-prim".revision = (((hackage."ghc-prim")."0.6.1").revisions).default; + "unix".revision = (((hackage."unix")."2.7.2.2").revisions).default; + "ghc-heap".revision = (((hackage."ghc-heap")."8.10.5").revisions).default; + "rts".revision = (((hackage."rts")."1.0.1").revisions).default; + "deepseq".revision = (((hackage."deepseq")."1.4.4.0").revisions).default; + "network".revision = (((hackage."network")."2.8.0.1").revisions).default; + "directory".revision = (((hackage."directory")."1.3.6.1").revisions).default; + "template-haskell".revision = (((hackage."template-haskell")."2.16.0.0").revisions).default; + "containers".revision = (((hackage."containers")."0.6.4.1").revisions).default; + "base".revision = (((hackage."base")."4.14.2.0").revisions).default; + "time".revision = (((hackage."time")."1.9.3").revisions).default; + "terminfo".revision = (((hackage."terminfo")."0.4.1.4").revisions).default; + "transformers".revision = (((hackage."transformers")."0.5.6.2").revisions).default; + "filepath".revision = (((hackage."filepath")."1.4.2.1").revisions).default; + "process".revision = (((hackage."process")."1.6.11.0").revisions).default; + "pretty".revision = (((hackage."pretty")."1.1.3.6").revisions).default; + "ghc-boot-th".revision = (((hackage."ghc-boot-th")."8.10.5").revisions).default; + "array".revision = (((hackage."array")."0.5.4.0").revisions).default; + "integer-gmp".revision = (((hackage."integer-gmp")."1.0.3.0").revisions).default; + }; + compiler = { + version = "8.10.5"; + nix-name = "ghc8105"; + packages = { + "ghc-prim" = "0.6.1"; + "ghc-heap" = "8.10.5"; + "rts" = "1.0.1"; + "deepseq" = "1.4.4.0"; + "template-haskell" = "2.16.0.0"; + "containers" = "0.6.4.1"; + "base" = "4.14.2.0"; + "time" = "1.9.3"; + "terminfo" = "0.4.1.4"; + "transformers" = "0.5.6.2"; + "filepath" = "1.4.2.1"; + "pretty" = "1.1.3.6"; + "ghc-boot-th" = "8.10.5"; + "array" = "0.5.4.0"; + "integer-gmp" = "1.0.3.0"; + }; + }; + }; + extras = hackage: + { + packages = { + ghc = ./.plan.nix/ghc.nix; + bytestring = ./.plan.nix/bytestring.nix; + remote-iserv = ./.plan.nix/remote-iserv.nix; + iserv-proxy = ./.plan.nix/iserv-proxy.nix; + hpc = ./.plan.nix/hpc.nix; + libiserv = ./.plan.nix/libiserv.nix; + ghc-boot = ./.plan.nix/ghc-boot.nix; + ghci = ./.plan.nix/ghci.nix; + iserv = ./.plan.nix/iserv.nix; + }; + }; + modules = [ + ({ lib, ... }: + { + packages = { + "ghc" = { + flags = { + "stage1" = lib.mkOverride 900 false; + "stage2" = lib.mkOverride 900 false; + "integer-gmp" = lib.mkOverride 900 false; + "stage3" = lib.mkOverride 900 false; + "dynamic-system-linker" = lib.mkOverride 900 true; + "ghci" = lib.mkOverride 900 true; + "integer-simple" = lib.mkOverride 900 false; + "terminfo" = lib.mkOverride 900 true; + }; + }; + "bytestring" = { + flags = { "integer-simple" = lib.mkOverride 900 false; }; + }; + "remote-iserv" = { flags = {}; }; + "iserv-proxy" = { flags = {}; }; + "hpc" = { flags = {}; }; + "libiserv" = { flags = { "network" = lib.mkOverride 900 true; }; }; + "ghc-boot" = { flags = {}; }; + "ghci" = { flags = { "ghci" = lib.mkOverride 900 true; }; }; + "iserv" = { flags = {}; }; + }; + }) + ]; + } \ No newline at end of file diff --git a/materialized/ghc8105/cabal-install/.plan.nix/cabal-install.nix b/materialized/ghc8105/cabal-install/.plan.nix/cabal-install.nix new file mode 100644 index 0000000000..d19baab10f --- /dev/null +++ b/materialized/ghc8105/cabal-install/.plan.nix/cabal-install.nix @@ -0,0 +1,361 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { + native-dns = true; + debug-expensive-assertions = false; + debug-conflict-sets = false; + debug-tracetree = false; + lukko = true; + }; + package = { + specVersion = "1.10"; + identifier = { name = "cabal-install"; version = "3.4.0.0"; }; + license = "BSD-3-Clause"; + copyright = "2003-2020, Cabal Development Team"; + maintainer = "Cabal Development Team "; + author = "Cabal Development Team (see AUTHORS file)"; + homepage = "http://www.haskell.org/cabal/"; + url = ""; + synopsis = "The command-line interface for Cabal and Hackage."; + description = "The \\'cabal\\' command-line program simplifies the process of managing\nHaskell software by automating the fetching, configuration, compilation\nand installation of Haskell libraries and programs."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = [ + "README.md" + "bash-completion/cabal" + "changelog" + "tests/IntegrationTests2/build/keep-going/cabal.project" + "tests/IntegrationTests2/build/keep-going/p/P.hs" + "tests/IntegrationTests2/build/keep-going/p/p.cabal" + "tests/IntegrationTests2/build/keep-going/q/Q.hs" + "tests/IntegrationTests2/build/keep-going/q/q.cabal" + "tests/IntegrationTests2/build/local-tarball/cabal.project" + "tests/IntegrationTests2/build/local-tarball/q/Q.hs" + "tests/IntegrationTests2/build/local-tarball/q/q.cabal" + "tests/IntegrationTests2/build/setup-custom1/A.hs" + "tests/IntegrationTests2/build/setup-custom1/Setup.hs" + "tests/IntegrationTests2/build/setup-custom1/a.cabal" + "tests/IntegrationTests2/build/setup-custom2/A.hs" + "tests/IntegrationTests2/build/setup-custom2/Setup.hs" + "tests/IntegrationTests2/build/setup-custom2/a.cabal" + "tests/IntegrationTests2/build/setup-simple/A.hs" + "tests/IntegrationTests2/build/setup-simple/Setup.hs" + "tests/IntegrationTests2/build/setup-simple/a.cabal" + "tests/IntegrationTests2/exception/bad-config/cabal.project" + "tests/IntegrationTests2/exception/build/Main.hs" + "tests/IntegrationTests2/exception/build/a.cabal" + "tests/IntegrationTests2/exception/configure/a.cabal" + "tests/IntegrationTests2/exception/no-pkg/empty.in" + "tests/IntegrationTests2/exception/no-pkg2/cabal.project" + "tests/IntegrationTests2/regression/3324/cabal.project" + "tests/IntegrationTests2/regression/3324/p/P.hs" + "tests/IntegrationTests2/regression/3324/p/p.cabal" + "tests/IntegrationTests2/regression/3324/q/Q.hs" + "tests/IntegrationTests2/regression/3324/q/q.cabal" + "tests/IntegrationTests2/targets/all-disabled/cabal.project" + "tests/IntegrationTests2/targets/all-disabled/p.cabal" + "tests/IntegrationTests2/targets/benchmarks-disabled/cabal.project" + "tests/IntegrationTests2/targets/benchmarks-disabled/p.cabal" + "tests/IntegrationTests2/targets/benchmarks-disabled/q/q.cabal" + "tests/IntegrationTests2/targets/complex/cabal.project" + "tests/IntegrationTests2/targets/complex/q/Q.hs" + "tests/IntegrationTests2/targets/complex/q/q.cabal" + "tests/IntegrationTests2/targets/empty-pkg/cabal.project" + "tests/IntegrationTests2/targets/empty-pkg/p.cabal" + "tests/IntegrationTests2/targets/empty/cabal.project" + "tests/IntegrationTests2/targets/empty/foo.hs" + "tests/IntegrationTests2/targets/exes-disabled/cabal.project" + "tests/IntegrationTests2/targets/exes-disabled/p/p.cabal" + "tests/IntegrationTests2/targets/exes-disabled/q/q.cabal" + "tests/IntegrationTests2/targets/lib-only/p.cabal" + "tests/IntegrationTests2/targets/libs-disabled/cabal.project" + "tests/IntegrationTests2/targets/libs-disabled/p/p.cabal" + "tests/IntegrationTests2/targets/libs-disabled/q/q.cabal" + "tests/IntegrationTests2/targets/multiple-exes/cabal.project" + "tests/IntegrationTests2/targets/multiple-exes/p.cabal" + "tests/IntegrationTests2/targets/multiple-libs/cabal.project" + "tests/IntegrationTests2/targets/multiple-libs/p/p.cabal" + "tests/IntegrationTests2/targets/multiple-libs/q/q.cabal" + "tests/IntegrationTests2/targets/multiple-tests/cabal.project" + "tests/IntegrationTests2/targets/multiple-tests/p.cabal" + "tests/IntegrationTests2/targets/simple/P.hs" + "tests/IntegrationTests2/targets/simple/app/Main.hs" + "tests/IntegrationTests2/targets/simple/cabal.project" + "tests/IntegrationTests2/targets/simple/p.cabal" + "tests/IntegrationTests2/targets/simple/q/Q.hs" + "tests/IntegrationTests2/targets/simple/q/QQ.hs" + "tests/IntegrationTests2/targets/simple/q/q.cabal" + "tests/IntegrationTests2/targets/test-only/p.cabal" + "tests/IntegrationTests2/targets/tests-disabled/cabal.project" + "tests/IntegrationTests2/targets/tests-disabled/p.cabal" + "tests/IntegrationTests2/targets/tests-disabled/q/q.cabal" + "tests/IntegrationTests2/targets/variety/cabal.project" + "tests/IntegrationTests2/targets/variety/p.cabal" + "tests/IntegrationTests2/build/local-tarball/p-0.1.tar.gz" + ]; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + exes = { + "cabal" = { + depends = ((((([ + (hsPkgs."async" or (errorHandler.buildDepError "async")) + (hsPkgs."array" or (errorHandler.buildDepError "array")) + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."base16-bytestring" or (errorHandler.buildDepError "base16-bytestring")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."cryptohash-sha256" or (errorHandler.buildDepError "cryptohash-sha256")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."echo" or (errorHandler.buildDepError "echo")) + (hsPkgs."edit-distance" or (errorHandler.buildDepError "edit-distance")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."hashable" or (errorHandler.buildDepError "hashable")) + (hsPkgs."HTTP" or (errorHandler.buildDepError "HTTP")) + (hsPkgs."mtl" or (errorHandler.buildDepError "mtl")) + (hsPkgs."network-uri" or (errorHandler.buildDepError "network-uri")) + (hsPkgs."pretty" or (errorHandler.buildDepError "pretty")) + (hsPkgs."process" or (errorHandler.buildDepError "process")) + (hsPkgs."random" or (errorHandler.buildDepError "random")) + (hsPkgs."stm" or (errorHandler.buildDepError "stm")) + (hsPkgs."tar" or (errorHandler.buildDepError "tar")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + (hsPkgs."zlib" or (errorHandler.buildDepError "zlib")) + (hsPkgs."hackage-security" or (errorHandler.buildDepError "hackage-security")) + (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."parsec" or (errorHandler.buildDepError "parsec")) + (hsPkgs."regex-base" or (errorHandler.buildDepError "regex-base")) + (hsPkgs."regex-posix" or (errorHandler.buildDepError "regex-posix")) + ] ++ (pkgs.lib).optionals (!(compiler.isGhc && (compiler.version).ge "8.0")) [ + (hsPkgs."fail" or (errorHandler.buildDepError "fail")) + (hsPkgs."semigroups" or (errorHandler.buildDepError "semigroups")) + ]) ++ (pkgs.lib).optionals (flags.native-dns) (if system.isWindows + then [ (hsPkgs."windns" or (errorHandler.buildDepError "windns")) ] + else [ + (hsPkgs."resolv" or (errorHandler.buildDepError "resolv")) + ])) ++ (if system.isWindows + then [ + (hsPkgs."Win32" or (errorHandler.buildDepError "Win32")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + ] + else [ + (hsPkgs."unix" or (errorHandler.buildDepError "unix")) + ])) ++ (if flags.lukko + then [ (hsPkgs."lukko" or (errorHandler.buildDepError "lukko")) ] + else [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + ])) ++ (pkgs.lib).optional (flags.debug-conflict-sets) (hsPkgs."base" or (errorHandler.buildDepError "base"))) ++ (pkgs.lib).optional (flags.debug-tracetree) (hsPkgs."tracetree" or (errorHandler.buildDepError "tracetree")); + libs = (pkgs.lib).optional (system.isAix) (pkgs."bsd" or (errorHandler.sysDepError "bsd")); + buildable = true; + modules = [ + "Distribution/Deprecated/ParseUtils" + "Distribution/Deprecated/ReadP" + "Distribution/Deprecated/ViewAsFieldDescr" + "Distribution/Client/BuildReports/Anonymous" + "Distribution/Client/BuildReports/Lens" + "Distribution/Client/BuildReports/Storage" + "Distribution/Client/BuildReports/Types" + "Distribution/Client/BuildReports/Upload" + "Distribution/Client/Check" + "Distribution/Client/CmdBench" + "Distribution/Client/CmdBuild" + "Distribution/Client/CmdClean" + "Distribution/Client/CmdConfigure" + "Distribution/Client/CmdErrorMessages" + "Distribution/Client/CmdExec" + "Distribution/Client/CmdFreeze" + "Distribution/Client/CmdHaddock" + "Distribution/Client/CmdInstall" + "Distribution/Client/CmdInstall/ClientInstallFlags" + "Distribution/Client/CmdInstall/ClientInstallTargetSelector" + "Distribution/Client/CmdLegacy" + "Distribution/Client/CmdListBin" + "Distribution/Client/CmdRepl" + "Distribution/Client/CmdRun" + "Distribution/Client/CmdSdist" + "Distribution/Client/CmdTest" + "Distribution/Client/CmdUpdate" + "Distribution/Client/Compat/Directory" + "Distribution/Client/Compat/ExecutablePath" + "Distribution/Client/Compat/FilePerms" + "Distribution/Client/Compat/Orphans" + "Distribution/Client/Compat/Prelude" + "Distribution/Client/Compat/Process" + "Distribution/Client/Compat/Semaphore" + "Distribution/Client/Config" + "Distribution/Client/Configure" + "Distribution/Client/Dependency" + "Distribution/Client/Dependency/Types" + "Distribution/Client/DistDirLayout" + "Distribution/Client/Exec" + "Distribution/Client/Fetch" + "Distribution/Client/FetchUtils" + "Distribution/Client/FileMonitor" + "Distribution/Client/Freeze" + "Distribution/Client/GZipUtils" + "Distribution/Client/GenBounds" + "Distribution/Client/Get" + "Distribution/Client/Glob" + "Distribution/Client/GlobalFlags" + "Distribution/Client/Haddock" + "Distribution/Client/HashValue" + "Distribution/Client/HttpUtils" + "Distribution/Client/IndexUtils" + "Distribution/Client/IndexUtils/ActiveRepos" + "Distribution/Client/IndexUtils/IndexState" + "Distribution/Client/IndexUtils/Timestamp" + "Distribution/Client/Init" + "Distribution/Client/Init/Command" + "Distribution/Client/Init/Defaults" + "Distribution/Client/Init/FileCreators" + "Distribution/Client/Init/Heuristics" + "Distribution/Client/Init/Licenses" + "Distribution/Client/Init/Prompt" + "Distribution/Client/Init/Types" + "Distribution/Client/Init/Utils" + "Distribution/Client/Install" + "Distribution/Client/InstallPlan" + "Distribution/Client/InstallSymlink" + "Distribution/Client/JobControl" + "Distribution/Client/List" + "Distribution/Client/Manpage" + "Distribution/Client/ManpageFlags" + "Distribution/Client/Nix" + "Distribution/Client/NixStyleOptions" + "Distribution/Client/Outdated" + "Distribution/Client/PackageHash" + "Distribution/Client/ParseUtils" + "Distribution/Client/ProjectBuilding" + "Distribution/Client/ProjectBuilding/Types" + "Distribution/Client/ProjectConfig" + "Distribution/Client/ProjectConfig/Legacy" + "Distribution/Client/ProjectConfig/Types" + "Distribution/Client/ProjectFlags" + "Distribution/Client/ProjectOrchestration" + "Distribution/Client/ProjectPlanOutput" + "Distribution/Client/ProjectPlanning" + "Distribution/Client/ProjectPlanning/Types" + "Distribution/Client/RebuildMonad" + "Distribution/Client/Reconfigure" + "Distribution/Client/Run" + "Distribution/Client/Sandbox" + "Distribution/Client/Sandbox/PackageEnvironment" + "Distribution/Client/SavedFlags" + "Distribution/Client/Security/DNS" + "Distribution/Client/Security/HTTP" + "Distribution/Client/Setup" + "Distribution/Client/SetupWrapper" + "Distribution/Client/SolverInstallPlan" + "Distribution/Client/SourceFiles" + "Distribution/Client/SrcDist" + "Distribution/Client/Store" + "Distribution/Client/Tar" + "Distribution/Client/TargetProblem" + "Distribution/Client/TargetSelector" + "Distribution/Client/Targets" + "Distribution/Client/Types" + "Distribution/Client/Types/AllowNewer" + "Distribution/Client/Types/BuildResults" + "Distribution/Client/Types/ConfiguredId" + "Distribution/Client/Types/ConfiguredPackage" + "Distribution/Client/Types/Credentials" + "Distribution/Client/Types/InstallMethod" + "Distribution/Client/Types/OverwritePolicy" + "Distribution/Client/Types/PackageLocation" + "Distribution/Client/Types/PackageSpecifier" + "Distribution/Client/Types/ReadyPackage" + "Distribution/Client/Types/Repo" + "Distribution/Client/Types/RepoName" + "Distribution/Client/Types/SourcePackageDb" + "Distribution/Client/Types/SourceRepo" + "Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy" + "Distribution/Client/Update" + "Distribution/Client/Upload" + "Distribution/Client/Utils" + "Distribution/Client/Utils/Assertion" + "Distribution/Client/Utils/Json" + "Distribution/Client/Utils/Parsec" + "Distribution/Client/VCS" + "Distribution/Client/Win32SelfUpgrade" + "Distribution/Client/World" + "Distribution/Solver/Compat/Prelude" + "Distribution/Solver/Modular" + "Distribution/Solver/Modular/Assignment" + "Distribution/Solver/Modular/Builder" + "Distribution/Solver/Modular/Configured" + "Distribution/Solver/Modular/ConfiguredConversion" + "Distribution/Solver/Modular/ConflictSet" + "Distribution/Solver/Modular/Cycles" + "Distribution/Solver/Modular/Dependency" + "Distribution/Solver/Modular/Explore" + "Distribution/Solver/Modular/Flag" + "Distribution/Solver/Modular/Index" + "Distribution/Solver/Modular/IndexConversion" + "Distribution/Solver/Modular/LabeledGraph" + "Distribution/Solver/Modular/Linking" + "Distribution/Solver/Modular/Log" + "Distribution/Solver/Modular/Message" + "Distribution/Solver/Modular/PSQ" + "Distribution/Solver/Modular/Package" + "Distribution/Solver/Modular/Preference" + "Distribution/Solver/Modular/RetryLog" + "Distribution/Solver/Modular/Solver" + "Distribution/Solver/Modular/Tree" + "Distribution/Solver/Modular/Validate" + "Distribution/Solver/Modular/Var" + "Distribution/Solver/Modular/Version" + "Distribution/Solver/Modular/WeightedPSQ" + "Distribution/Solver/Types/ComponentDeps" + "Distribution/Solver/Types/ConstraintSource" + "Distribution/Solver/Types/DependencyResolver" + "Distribution/Solver/Types/Flag" + "Distribution/Solver/Types/InstSolverPackage" + "Distribution/Solver/Types/InstalledPreference" + "Distribution/Solver/Types/LabeledPackageConstraint" + "Distribution/Solver/Types/OptionalStanza" + "Distribution/Solver/Types/PackageConstraint" + "Distribution/Solver/Types/PackageFixedDeps" + "Distribution/Solver/Types/PackageIndex" + "Distribution/Solver/Types/PackagePath" + "Distribution/Solver/Types/PackagePreferences" + "Distribution/Solver/Types/PkgConfigDb" + "Distribution/Solver/Types/Progress" + "Distribution/Solver/Types/ResolverPackage" + "Distribution/Solver/Types/Settings" + "Distribution/Solver/Types/SolverId" + "Distribution/Solver/Types/SolverPackage" + "Distribution/Solver/Types/SourcePackage" + "Distribution/Solver/Types/Variable" + "Paths_cabal_install" + ]; + hsSourceDirs = [ "main" "." ]; + mainPath = (((((((([ + "Main.hs" + ] ++ (pkgs.lib).optionals (compiler.isGhc && (compiler.version).ge "8.0") (([ + "" + ] ++ (pkgs.lib).optional (compiler.isGhc && (compiler.version).lt "8.8") "") ++ (pkgs.lib).optional (compiler.isGhc && (compiler.version).ge "8.10") "")) ++ (pkgs.lib).optional (system.isAix) "") ++ (pkgs.lib).optional (!(compiler.isGhc && (compiler.version).ge "8.0")) "") ++ (pkgs.lib).optionals (flags.native-dns) ([ + "" + ] ++ [ "" ])) ++ [ "" ]) ++ [ + "" + ]) ++ (pkgs.lib).optional (flags.debug-expensive-assertions) "") ++ (pkgs.lib).optional (flags.debug-conflict-sets) "") ++ (pkgs.lib).optional (flags.debug-tracetree) ""; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../.; } \ No newline at end of file diff --git a/materialized/ghc8105/cabal-install/default.nix b/materialized/ghc8105/cabal-install/default.nix new file mode 100644 index 0000000000..c003be125f --- /dev/null +++ b/materialized/ghc8105/cabal-install/default.nix @@ -0,0 +1,128 @@ +{ + pkgs = hackage: + { + packages = { + "cryptohash-sha256".revision = (((hackage."cryptohash-sha256")."0.11.102.0").revisions).default; + "cryptohash-sha256".flags.use-cbits = true; + "cryptohash-sha256".flags.exe = false; + "binary".revision = (((hackage."binary")."0.8.8.0").revisions).default; + "tar".revision = (((hackage."tar")."0.5.1.1").revisions).default; + "tar".flags.old-time = false; + "tar".flags.old-bytestring = false; + "ghc-prim".revision = (((hackage."ghc-prim")."0.6.1").revisions).default; + "edit-distance".revision = (((hackage."edit-distance")."0.2.2.1").revisions).default; + "stm".revision = (((hackage."stm")."2.5.0.1").revisions).default; + "unix".revision = (((hackage."unix")."2.7.2.2").revisions).default; + "mtl".revision = (((hackage."mtl")."2.2.2").revisions).default; + "network-uri".revision = (((hackage."network-uri")."2.6.4.1").revisions).default; + "regex-base".revision = (((hackage."regex-base")."0.94.0.1").revisions).default; + "zlib".revision = (((hackage."zlib")."0.6.2.3").revisions).default; + "zlib".flags.non-blocking-ffi = false; + "zlib".flags.bundled-c-zlib = false; + "zlib".flags.pkg-config = false; + "rts".revision = (((hackage."rts")."1.0.1").revisions).default; + "regex-posix".revision = (((hackage."regex-posix")."0.96.0.0").revisions).default; + "regex-posix".flags._regex-posix-clib = false; + "deepseq".revision = (((hackage."deepseq")."1.4.4.0").revisions).default; + "random".revision = (((hackage."random")."1.2.0").revisions).default; + "network".revision = (((hackage."network")."3.1.2.1").revisions).default; + "network".flags.devel = false; + "splitmix".revision = (((hackage."splitmix")."0.1.0.3").revisions).default; + "splitmix".flags.optimised-mixer = false; + "async".revision = (((hackage."async")."2.2.3").revisions).default; + "async".flags.bench = false; + "parsec".revision = (((hackage."parsec")."3.1.14.0").revisions).default; + "echo".revision = (((hackage."echo")."0.1.4").revisions).default; + "echo".flags.example = false; + "hsc2hs".revision = (((hackage."hsc2hs")."0.68.7").revisions).default; + "hsc2hs".flags.in-ghc-tree = false; + "resolv".revision = (((hackage."resolv")."0.1.2.0").revisions).default; + "directory".revision = (((hackage."directory")."1.3.6.0").revisions).default; + "template-haskell".revision = (((hackage."template-haskell")."2.16.0.0").revisions).default; + "containers".revision = (((hackage."containers")."0.6.4.1").revisions).default; + "bytestring".revision = (((hackage."bytestring")."0.10.12.0").revisions).default; + "text".revision = (((hackage."text")."1.2.4.1").revisions).default; + "Cabal".revision = (((hackage."Cabal")."3.4.0.0").revisions).default; + "Cabal".flags.bundled-binary-generic = false; + "base64-bytestring".revision = (((hackage."base64-bytestring")."1.2.0.1").revisions).default; + "base".revision = (((hackage."base")."4.14.2.0").revisions).default; + "time".revision = (((hackage."time")."1.9.3").revisions).default; + "th-compat".revision = (((hackage."th-compat")."0.1.1").revisions).default; + "base16-bytestring".revision = (((hackage."base16-bytestring")."0.1.1.7").revisions).default; + "transformers".revision = (((hackage."transformers")."0.5.6.2").revisions).default; + "hashable".revision = (((hackage."hashable")."1.3.1.0").revisions).default; + "hashable".flags.integer-gmp = true; + "HTTP".revision = (((hackage."HTTP")."4000.3.15").revisions).default; + "HTTP".flags.mtl1 = false; + "HTTP".flags.conduit10 = false; + "HTTP".flags.warn-as-error = false; + "HTTP".flags.warp-tests = false; + "HTTP".flags.network-uri = true; + "filepath".revision = (((hackage."filepath")."1.4.2.1").revisions).default; + "ed25519".revision = (((hackage."ed25519")."0.0.5.0").revisions).default; + "ed25519".flags.test-hlint = true; + "ed25519".flags.test-properties = true; + "ed25519".flags.test-doctests = true; + "ed25519".flags.no-donna = true; + "process".revision = (((hackage."process")."1.6.9.0").revisions).default; + "pretty".revision = (((hackage."pretty")."1.1.3.6").revisions).default; + "lukko".revision = (((hackage."lukko")."0.1.1.3").revisions).default; + "lukko".flags.ofd-locking = true; + "ghc-boot-th".revision = (((hackage."ghc-boot-th")."8.10.5").revisions).default; + "array".revision = (((hackage."array")."0.5.4.0").revisions).default; + "hackage-security".revision = (((hackage."hackage-security")."0.6.0.1").revisions).default; + "hackage-security".flags.old-directory = false; + "hackage-security".flags.use-network-uri = true; + "hackage-security".flags.base48 = true; + "hackage-security".flags.lukko = true; + "hackage-security".flags.mtl21 = false; + "integer-gmp".revision = (((hackage."integer-gmp")."1.0.3.0").revisions).default; + }; + compiler = { + version = "8.10.5"; + nix-name = "ghc8105"; + packages = { + "binary" = "0.8.8.0"; + "ghc-prim" = "0.6.1"; + "stm" = "2.5.0.1"; + "unix" = "2.7.2.2"; + "mtl" = "2.2.2"; + "rts" = "1.0.1"; + "deepseq" = "1.4.4.0"; + "parsec" = "3.1.14.0"; + "directory" = "1.3.6.0"; + "template-haskell" = "2.16.0.0"; + "containers" = "0.6.4.1"; + "bytestring" = "0.10.12.0"; + "text" = "1.2.4.1"; + "base" = "4.14.2.0"; + "time" = "1.9.3"; + "transformers" = "0.5.6.2"; + "filepath" = "1.4.2.1"; + "process" = "1.6.9.0"; + "pretty" = "1.1.3.6"; + "ghc-boot-th" = "8.10.5"; + "array" = "0.5.4.0"; + "integer-gmp" = "1.0.3.0"; + }; + }; + }; + extras = hackage: + { packages = { cabal-install = ./.plan.nix/cabal-install.nix; }; }; + modules = [ + ({ lib, ... }: + { + packages = { + "cabal-install" = { + flags = { + "native-dns" = lib.mkOverride 900 true; + "debug-expensive-assertions" = lib.mkOverride 900 false; + "debug-tracetree" = lib.mkOverride 900 false; + "lukko" = lib.mkOverride 900 true; + "debug-conflict-sets" = lib.mkOverride 900 false; + }; + }; + }; + }) + ]; + } \ No newline at end of file diff --git a/materialized/ghc8105/nix-tools/.plan.nix/hackage-db.nix b/materialized/ghc8105/nix-tools/.plan.nix/hackage-db.nix new file mode 100644 index 0000000000..94265e7c77 --- /dev/null +++ b/materialized/ghc8105/nix-tools/.plan.nix/hackage-db.nix @@ -0,0 +1,100 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = { install-examples = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "hackage-db"; version = "2.1.0.1"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "Peter Simons "; + author = "Peter Simons, Alexander Altman, Ben James"; + homepage = "https://github.com/peti/hackage-db#readme"; + url = ""; + synopsis = "Access cabal-install's Hackage database via Data.Map"; + description = "This library provides convenient access to the local copy of the Hackage\ndatabase that \\\"cabal update\\\" creates. Check out\n for a collection\nof simple example programs that demonstrate how to use this code."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = []; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."exceptions" or (errorHandler.buildDepError "exceptions")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."tar" or (errorHandler.buildDepError "tar")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) + (hsPkgs."utf8-string" or (errorHandler.buildDepError "utf8-string")) + ]; + buildable = true; + modules = [ + "Paths_hackage_db" + "Distribution/Hackage/DB" + "Distribution/Hackage/DB/Builder" + "Distribution/Hackage/DB/Errors" + "Distribution/Hackage/DB/MetaData" + "Distribution/Hackage/DB/Parsed" + "Distribution/Hackage/DB/Path" + "Distribution/Hackage/DB/Unparsed" + "Distribution/Hackage/DB/Utility" + ]; + hsSourceDirs = [ "src" ]; + }; + exes = { + "list-known-versions" = { + depends = (pkgs.lib).optionals (flags.install-examples) [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."hackage-db" or (errorHandler.buildDepError "hackage-db")) + ]; + buildable = if flags.install-examples then true else false; + hsSourceDirs = [ "example" ]; + mainPath = [ "list-known-versions.hs" ] ++ [ "" ]; + }; + "show-meta-data" = { + depends = (pkgs.lib).optionals (flags.install-examples) [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."hackage-db" or (errorHandler.buildDepError "hackage-db")) + (hsPkgs."utf8-string" or (errorHandler.buildDepError "utf8-string")) + ]; + buildable = if flags.install-examples then true else false; + hsSourceDirs = [ "example" ]; + mainPath = [ "show-meta-data.hs" ] ++ [ "" ]; + }; + "show-package-versions" = { + depends = (pkgs.lib).optionals (flags.install-examples) [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."hackage-db" or (errorHandler.buildDepError "hackage-db")) + ]; + buildable = if flags.install-examples then true else false; + hsSourceDirs = [ "example" ]; + mainPath = [ "show-package-versions.hs" ] ++ [ "" ]; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault .././.source-repository-packages/0; } \ No newline at end of file diff --git a/materialized/ghc8105/nix-tools/.plan.nix/nix-tools.nix b/materialized/ghc8105/nix-tools/.plan.nix/nix-tools.nix new file mode 100644 index 0000000000..d6d4923239 --- /dev/null +++ b/materialized/ghc8105/nix-tools/.plan.nix/nix-tools.nix @@ -0,0 +1,233 @@ +{ system + , compiler + , flags + , pkgs + , hsPkgs + , pkgconfPkgs + , errorHandler + , config + , ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "nix-tools"; version = "0.1.0.0"; }; + license = "BSD-3-Clause"; + copyright = ""; + maintainer = "moritz.angermann@gmail.com"; + author = "Moritz Angermann"; + homepage = ""; + url = ""; + synopsis = "cabal/stack to nix translation tools"; + description = "A set of tools to aid in trating stack and cabal projects into nix expressions."; + buildType = "Simple"; + isLocal = true; + detailLevel = "FullDetails"; + licenseFiles = [ "LICENSE" ]; + dataDir = "."; + dataFiles = []; + extraSrcFiles = [ "ChangeLog.md" ]; + extraTmpFiles = []; + extraDocFiles = []; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) + (hsPkgs."aeson-pretty" or (errorHandler.buildDepError "aeson-pretty")) + (hsPkgs."base16-bytestring" or (errorHandler.buildDepError "base16-bytestring")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."cryptohash-sha256" or (errorHandler.buildDepError "cryptohash-sha256")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."data-fix" or (errorHandler.buildDepError "data-fix")) + (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."extra" or (errorHandler.buildDepError "extra")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."hnix" or (errorHandler.buildDepError "hnix")) + (hsPkgs."hpack" or (errorHandler.buildDepError "hpack")) + (hsPkgs."http-client" or (errorHandler.buildDepError "http-client")) + (hsPkgs."http-client-tls" or (errorHandler.buildDepError "http-client-tls")) + (hsPkgs."http-types" or (errorHandler.buildDepError "http-types")) + (hsPkgs."optparse-applicative" or (errorHandler.buildDepError "optparse-applicative")) + (hsPkgs."prettyprinter" or (errorHandler.buildDepError "prettyprinter")) + (hsPkgs."process" or (errorHandler.buildDepError "process")) + (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + (hsPkgs."unordered-containers" or (errorHandler.buildDepError "unordered-containers")) + (hsPkgs."yaml" or (errorHandler.buildDepError "yaml")) + ]; + buildable = true; + modules = [ + "Cabal2Nix" + "Cabal2Nix/Util" + "Cabal2Nix/Plan" + "CabalName" + "CabalName/CLI" + "Distribution/Nixpkgs/Fetch" + "StackRepos" + "StackRepos/CLI" + "Stack2nix" + "Stack2nix/Cache" + "Stack2nix/CLI" + "Stack2nix/External/Resolve" + "Stack2nix/Project" + "Stack2nix/Stack" + ]; + hsSourceDirs = [ "lib" ]; + }; + exes = { + "cabal-to-nix" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."hpack" or (errorHandler.buildDepError "hpack")) + (hsPkgs."hnix" or (errorHandler.buildDepError "hnix")) + (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."prettyprinter" or (errorHandler.buildDepError "prettyprinter")) + ]; + buildable = true; + hsSourceDirs = [ "cabal2nix" ]; + mainPath = [ "Main.hs" ]; + }; + "hashes-to-nix" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."hnix" or (errorHandler.buildDepError "hnix")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + (hsPkgs."data-fix" or (errorHandler.buildDepError "data-fix")) + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) + (hsPkgs."microlens" or (errorHandler.buildDepError "microlens")) + (hsPkgs."microlens-aeson" or (errorHandler.buildDepError "microlens-aeson")) + (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + ]; + buildable = true; + hsSourceDirs = [ "hashes2nix" ]; + mainPath = [ "Main.hs" ]; + }; + "plan-to-nix" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + (hsPkgs."hnix" or (errorHandler.buildDepError "hnix")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."hpack" or (errorHandler.buildDepError "hpack")) + (hsPkgs."unordered-containers" or (errorHandler.buildDepError "unordered-containers")) + (hsPkgs."vector" or (errorHandler.buildDepError "vector")) + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) + (hsPkgs."microlens" or (errorHandler.buildDepError "microlens")) + (hsPkgs."microlens-aeson" or (errorHandler.buildDepError "microlens-aeson")) + (hsPkgs."optparse-applicative" or (errorHandler.buildDepError "optparse-applicative")) + (hsPkgs."prettyprinter" or (errorHandler.buildDepError "prettyprinter")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + (hsPkgs."extra" or (errorHandler.buildDepError "extra")) + ]; + buildable = true; + modules = [ + "Plan2Nix" + "Plan2Nix/Cache" + "Plan2Nix/CLI" + "Plan2Nix/Project" + "Plan2Nix/Plan" + ]; + hsSourceDirs = [ "plan2nix" ]; + mainPath = [ "Main.hs" ]; + }; + "hackage-to-nix" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + (hsPkgs."hackage-db" or (errorHandler.buildDepError "hackage-db")) + (hsPkgs."hnix" or (errorHandler.buildDepError "hnix")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) + (hsPkgs."aeson-pretty" or (errorHandler.buildDepError "aeson-pretty")) + (hsPkgs."containers" or (errorHandler.buildDepError "containers")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."cryptohash-sha256" or (errorHandler.buildDepError "cryptohash-sha256")) + (hsPkgs."base16-bytestring" or (errorHandler.buildDepError "base16-bytestring")) + (hsPkgs."base64-bytestring" or (errorHandler.buildDepError "base64-bytestring")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) + ]; + buildable = true; + hsSourceDirs = [ "hackage2nix" ]; + mainPath = [ "Main.hs" ]; + }; + "lts-to-nix" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + (hsPkgs."hnix" or (errorHandler.buildDepError "hnix")) + (hsPkgs."yaml" or (errorHandler.buildDepError "yaml")) + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) + (hsPkgs."microlens" or (errorHandler.buildDepError "microlens")) + (hsPkgs."microlens-aeson" or (errorHandler.buildDepError "microlens-aeson")) + (hsPkgs."text" or (errorHandler.buildDepError "text")) + (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) + (hsPkgs."directory" or (errorHandler.buildDepError "directory")) + (hsPkgs."unordered-containers" or (errorHandler.buildDepError "unordered-containers")) + (hsPkgs."vector" or (errorHandler.buildDepError "vector")) + (hsPkgs."Cabal" or (errorHandler.buildDepError "Cabal")) + ]; + buildable = true; + hsSourceDirs = [ "lts2nix" ]; + mainPath = [ "Main.hs" ]; + }; + "stack-to-nix" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + ]; + buildable = true; + hsSourceDirs = [ "stack2nix" ]; + mainPath = [ "Main.hs" ]; + }; + "truncate-index" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."optparse-applicative" or (errorHandler.buildDepError "optparse-applicative")) + (hsPkgs."zlib" or (errorHandler.buildDepError "zlib")) + (hsPkgs."tar" or (errorHandler.buildDepError "tar")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."time" or (errorHandler.buildDepError "time")) + ]; + buildable = true; + hsSourceDirs = [ "truncate-index" ]; + mainPath = [ "Main.hs" ]; + }; + "stack-repos" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + ]; + buildable = true; + hsSourceDirs = [ "stack-repos" ]; + mainPath = [ "Main.hs" ]; + }; + "cabal-name" = { + depends = [ + (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."nix-tools" or (errorHandler.buildDepError "nix-tools")) + ]; + buildable = true; + hsSourceDirs = [ "cabal-name" ]; + mainPath = [ "Main.hs" ]; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../.; } \ No newline at end of file diff --git a/materialized/ghc8105/nix-tools/default.nix b/materialized/ghc8105/nix-tools/default.nix new file mode 100644 index 0000000000..506023b688 --- /dev/null +++ b/materialized/ghc8105/nix-tools/default.nix @@ -0,0 +1,362 @@ +{ + pkgs = hackage: + { + packages = { + "http-client".revision = (((hackage."http-client")."0.6.4.1").revisions).default; + "http-client".flags.network-uri = true; + "cookie".revision = (((hackage."cookie")."0.4.5").revisions).default; + "void".revision = (((hackage."void")."0.7.3").revisions).default; + "void".flags.safe = false; + "semigroupoids".revision = (((hackage."semigroupoids")."5.3.5").revisions).default; + "semigroupoids".flags.comonad = true; + "semigroupoids".flags.unordered-containers = true; + "semigroupoids".flags.distributive = true; + "semigroupoids".flags.tagged = true; + "semigroupoids".flags.containers = true; + "semigroupoids".flags.contravariant = true; + "free".revision = (((hackage."free")."5.1.6").revisions).default; + "hnix-store-remote".revision = (((hackage."hnix-store-remote")."0.4.1.0").revisions).default; + "hnix-store-remote".flags.io-testsuite = false; + "cereal".revision = (((hackage."cereal")."0.5.8.1").revisions).default; + "cereal".flags.bytestring-builder = false; + "exceptions".revision = (((hackage."exceptions")."0.10.4").revisions).default; + "cryptohash-sha256".revision = (((hackage."cryptohash-sha256")."0.11.102.0").revisions).default; + "cryptohash-sha256".flags.use-cbits = true; + "cryptohash-sha256".flags.exe = false; + "binary".revision = (((hackage."binary")."0.8.8.0").revisions).default; + "hnix".revision = (((hackage."hnix")."0.12.0.1").revisions).default; + "hnix".flags.profiling = false; + "hnix".flags.optimize = false; + "tar".revision = (((hackage."tar")."0.5.1.1").revisions).default; + "tar".flags.old-time = false; + "tar".flags.old-bytestring = false; + "regex-tdfa".revision = (((hackage."regex-tdfa")."1.3.1.0").revisions).default; + "regex-tdfa".flags.force-o2 = false; + "ghc-prim".revision = (((hackage."ghc-prim")."0.6.1").revisions).default; + "text-metrics".revision = (((hackage."text-metrics")."0.3.0").revisions).default; + "text-metrics".flags.dev = false; + "utf8-string".revision = (((hackage."utf8-string")."1.0.2").revisions).default; + "bifunctors".revision = (((hackage."bifunctors")."5.5.10").revisions).default; + "bifunctors".flags.semigroups = true; + "bifunctors".flags.tagged = true; + "hashing".revision = (((hackage."hashing")."0.1.0.1").revisions).default; + "extra".revision = (((hackage."extra")."1.7.9").revisions).default; + "haskeline".revision = (((hackage."haskeline")."0.8.0.1").revisions).default; + "logict".revision = (((hackage."logict")."0.7.0.3").revisions).default; + "x509-validation".revision = (((hackage."x509-validation")."1.6.11").revisions).default; + "split".revision = (((hackage."split")."0.2.3.4").revisions).default; + "data-fix".revision = (((hackage."data-fix")."0.3.1").revisions).default; + "stm".revision = (((hackage."stm")."2.5.0.1").revisions).default; + "base-compat-batteries".revision = (((hackage."base-compat-batteries")."0.11.2").revisions).default; + "hourglass".revision = (((hackage."hourglass")."0.2.12").revisions).default; + "case-insensitive".revision = (((hackage."case-insensitive")."1.2.1.0").revisions).default; + "unix".revision = (((hackage."unix")."2.7.2.2").revisions).default; + "mtl".revision = (((hackage."mtl")."2.2.2").revisions).default; + "network-uri".revision = (((hackage."network-uri")."2.6.4.1").revisions).default; + "asn1-parse".revision = (((hackage."asn1-parse")."0.9.5").revisions).default; + "regex-base".revision = (((hackage."regex-base")."0.94.0.1").revisions).default; + "zlib".revision = (((hackage."zlib")."0.6.2.3").revisions).default; + "zlib".flags.non-blocking-ffi = false; + "zlib".flags.bundled-c-zlib = false; + "zlib".flags.pkg-config = false; + "rts".revision = (((hackage."rts")."1.0.1").revisions).default; + "cmdargs".revision = (((hackage."cmdargs")."0.10.21").revisions).default; + "cmdargs".flags.testprog = false; + "cmdargs".flags.quotation = true; + "cryptonite".revision = (((hackage."cryptonite")."0.28").revisions).default; + "cryptonite".flags.support_sse = false; + "cryptonite".flags.use_target_attributes = true; + "cryptonite".flags.integer-gmp = true; + "cryptonite".flags.support_rdrand = true; + "cryptonite".flags.support_aesni = true; + "cryptonite".flags.support_deepseq = true; + "cryptonite".flags.support_pclmuldq = false; + "cryptonite".flags.check_alignment = false; + "cryptonite".flags.old_toolchain_inliner = false; + "microlens-aeson".revision = (((hackage."microlens-aeson")."2.3.1").revisions).default; + "clock".revision = (((hackage."clock")."0.8.2").revisions).default; + "clock".flags.llvm = false; + "saltine".revision = (((hackage."saltine")."0.1.1.1").revisions).default; + "adjunctions".revision = (((hackage."adjunctions")."4.4").revisions).default; + "cryptohash-md5".revision = (((hackage."cryptohash-md5")."0.11.100.1").revisions).default; + "invariant".revision = (((hackage."invariant")."0.5.4").revisions).default; + "pem".revision = (((hackage."pem")."0.2.4").revisions).default; + "megaparsec".revision = (((hackage."megaparsec")."9.0.1").revisions).default; + "megaparsec".flags.dev = false; + "syb".revision = (((hackage."syb")."0.7.2.1").revisions).default; + "distributive".revision = (((hackage."distributive")."0.6.2.1").revisions).default; + "distributive".flags.semigroups = true; + "distributive".flags.tagged = true; + "asn1-encoding".revision = (((hackage."asn1-encoding")."0.9.6").revisions).default; + "QuickCheck".revision = (((hackage."QuickCheck")."2.14.2").revisions).default; + "QuickCheck".flags.templatehaskell = true; + "QuickCheck".flags.old-random = false; + "scientific".revision = (((hackage."scientific")."0.3.6.2").revisions).default; + "scientific".flags.integer-simple = false; + "scientific".flags.bytestring-builder = false; + "monadlist".revision = (((hackage."monadlist")."0.0.2").revisions).default; + "half".revision = (((hackage."half")."0.3.1").revisions).default; + "parallel".revision = (((hackage."parallel")."3.2.2.0").revisions).default; + "deepseq".revision = (((hackage."deepseq")."1.4.4.0").revisions).default; + "hnix-store-core".revision = (((hackage."hnix-store-core")."0.4.1.0").revisions).default; + "hnix-store-core".flags.bounded_memory = false; + "random".revision = (((hackage."random")."1.2.0").revisions).default; + "uuid-types".revision = (((hackage."uuid-types")."1.0.4").revisions).default; + "optparse-applicative".revision = (((hackage."optparse-applicative")."0.16.1.0").revisions).default; + "optparse-applicative".flags.process = true; + "network".revision = (((hackage."network")."3.1.2.1").revisions).default; + "network".flags.devel = false; + "connection".revision = (((hackage."connection")."0.3.1").revisions).default; + "splitmix".revision = (((hackage."splitmix")."0.1.0.3").revisions).default; + "splitmix".flags.optimised-mixer = false; + "async".revision = (((hackage."async")."2.2.3").revisions).default; + "async".flags.bench = false; + "dlist".revision = (((hackage."dlist")."1.0").revisions).default; + "dlist".flags.werror = false; + "conduit".revision = (((hackage."conduit")."1.3.4").revisions).default; + "ref-tf".revision = (((hackage."ref-tf")."0.4.0.2").revisions).default; + "x509-store".revision = (((hackage."x509-store")."1.6.7").revisions).default; + "lens-family-th".revision = (((hackage."lens-family-th")."0.5.1.0").revisions).default; + "semigroups".revision = (((hackage."semigroups")."0.19.1").revisions).default; + "semigroups".flags.bytestring = true; + "semigroups".flags.unordered-containers = true; + "semigroups".flags.text = true; + "semigroups".flags.tagged = true; + "semigroups".flags.containers = true; + "semigroups".flags.binary = true; + "semigroups".flags.hashable = true; + "semigroups".flags.transformers = true; + "semigroups".flags.deepseq = true; + "semigroups".flags.bytestring-builder = false; + "semigroups".flags.template-haskell = true; + "lifted-base".revision = (((hackage."lifted-base")."0.2.3.12").revisions).default; + "parsec".revision = (((hackage."parsec")."3.1.14.0").revisions).default; + "hsc2hs".revision = (((hackage."hsc2hs")."0.68.7").revisions).default; + "hsc2hs".flags.in-ghc-tree = false; + "directory".revision = (((hackage."directory")."1.3.6.0").revisions).default; + "yaml".revision = (((hackage."yaml")."0.11.5.0").revisions).default; + "yaml".flags.no-exe = true; + "yaml".flags.no-examples = true; + "transformers-compat".revision = (((hackage."transformers-compat")."0.6.6").revisions).default; + "transformers-compat".flags.five = false; + "transformers-compat".flags.generic-deriving = true; + "transformers-compat".flags.two = false; + "transformers-compat".flags.five-three = true; + "transformers-compat".flags.mtl = true; + "transformers-compat".flags.four = false; + "transformers-compat".flags.three = false; + "neat-interpolation".revision = (((hackage."neat-interpolation")."0.5.1.2").revisions).default; + "hpack".revision = (((hackage."hpack")."0.34.4").revisions).default; + "template-haskell".revision = (((hackage."template-haskell")."2.16.0.0").revisions).default; + "mono-traversable".revision = (((hackage."mono-traversable")."1.0.15.1").revisions).default; + "vector".revision = (((hackage."vector")."0.12.2.0").revisions).default; + "vector".flags.unsafechecks = false; + "vector".flags.internalchecks = false; + "vector".flags.wall = false; + "vector".flags.boundschecks = true; + "call-stack".revision = (((hackage."call-stack")."0.3.0").revisions).default; + "primitive".revision = (((hackage."primitive")."0.7.1.0").revisions).default; + "profunctors".revision = (((hackage."profunctors")."5.6.2").revisions).default; + "blaze-builder".revision = (((hackage."blaze-builder")."0.4.2.1").revisions).default; + "base-compat".revision = (((hackage."base-compat")."0.11.2").revisions).default; + "time-compat".revision = (((hackage."time-compat")."1.9.5").revisions).default; + "time-compat".flags.old-locale = false; + "x509-system".revision = (((hackage."x509-system")."1.6.6").revisions).default; + "ansi-terminal".revision = (((hackage."ansi-terminal")."0.11").revisions).default; + "ansi-terminal".flags.example = false; + "tagged".revision = (((hackage."tagged")."0.8.6.1").revisions).default; + "tagged".flags.transformers = true; + "tagged".flags.deepseq = true; + "x509".revision = (((hackage."x509")."1.7.5").revisions).default; + "lens".revision = (((hackage."lens")."4.19.2").revisions).default; + "lens".flags.j = false; + "lens".flags.test-properties = true; + "lens".flags.old-inline-pragmas = false; + "lens".flags.test-templates = true; + "lens".flags.trustworthy = true; + "lens".flags.test-doctests = true; + "lens".flags.benchmark-uniplate = false; + "lens".flags.inlining = true; + "lens".flags.dump-splices = false; + "lens".flags.test-hunit = true; + "lens".flags.safe = false; + "unliftio-core".revision = (((hackage."unliftio-core")."0.2.0.1").revisions).default; + "containers".revision = (((hackage."containers")."0.6.4.1").revisions).default; + "some".revision = (((hackage."some")."1.0.2").revisions).default; + "some".flags.newtype-unsafe = true; + "integer-logarithms".revision = (((hackage."integer-logarithms")."1.0.3.1").revisions).default; + "integer-logarithms".flags.check-bounds = false; + "integer-logarithms".flags.integer-gmp = true; + "semialign".revision = (((hackage."semialign")."1.1.0.1").revisions).default; + "semialign".flags.semigroupoids = true; + "reflection".revision = (((hackage."reflection")."2.1.6").revisions).default; + "reflection".flags.slow = false; + "reflection".flags.template-haskell = true; + "these".revision = (((hackage."these")."1.1.1.1").revisions).default; + "these".flags.assoc = true; + "socks".revision = (((hackage."socks")."0.6.1").revisions).default; + "streaming-commons".revision = (((hackage."streaming-commons")."0.2.2.1").revisions).default; + "streaming-commons".flags.use-bytestring-builder = false; + "haskell-lexer".revision = (((hackage."haskell-lexer")."1.1").revisions).default; + "lens-family".revision = (((hackage."lens-family")."2.1.0").revisions).default; + "bytestring".revision = (((hackage."bytestring")."0.10.12.0").revisions).default; + "ansi-wl-pprint".revision = (((hackage."ansi-wl-pprint")."0.6.9").revisions).default; + "ansi-wl-pprint".flags.example = false; + "basement".revision = (((hackage."basement")."0.0.11").revisions).default; + "cryptohash-sha1".revision = (((hackage."cryptohash-sha1")."0.11.100.1").revisions).default; + "serialise".revision = (((hackage."serialise")."0.2.3.0").revisions).default; + "serialise".flags.newtime15 = true; + "StateVar".revision = (((hackage."StateVar")."1.2.1").revisions).default; + "mime-types".revision = (((hackage."mime-types")."0.1.0.9").revisions).default; + "http-client-tls".revision = (((hackage."http-client-tls")."0.3.5.3").revisions).default; + "contravariant".revision = (((hackage."contravariant")."1.5.3").revisions).default; + "contravariant".flags.semigroups = true; + "contravariant".flags.tagged = true; + "contravariant".flags.statevar = true; + "indexed-traversable".revision = (((hackage."indexed-traversable")."0.1.1").revisions).default; + "parser-combinators".revision = (((hackage."parser-combinators")."1.2.1").revisions).default; + "parser-combinators".flags.dev = false; + "semialign-indexed".revision = (((hackage."semialign-indexed")."1.1").revisions).default; + "deriving-compat".revision = (((hackage."deriving-compat")."0.5.10").revisions).default; + "deriving-compat".flags.base-4-9 = true; + "deriving-compat".flags.template-haskell-2-11 = true; + "deriving-compat".flags.new-functor-classes = true; + "text".revision = (((hackage."text")."1.2.4.1").revisions).default; + "Cabal".revision = (((hackage."Cabal")."3.4.0.0").revisions).default; + "Cabal".flags.bundled-binary-generic = false; + "assoc".revision = (((hackage."assoc")."1.0.2").revisions).default; + "unordered-containers".revision = (((hackage."unordered-containers")."0.2.13.0").revisions).default; + "unordered-containers".flags.debug = false; + "base64-bytestring".revision = (((hackage."base64-bytestring")."1.2.0.1").revisions).default; + "aeson-pretty".revision = (((hackage."aeson-pretty")."0.8.8").revisions).default; + "aeson-pretty".flags.lib-only = false; + "base".revision = (((hackage."base")."4.14.2.0").revisions).default; + "comonad".revision = (((hackage."comonad")."5.0.8").revisions).default; + "comonad".flags.indexed-traversable = true; + "comonad".flags.distributive = true; + "comonad".flags.containers = true; + "time".revision = (((hackage."time")."1.9.3").revisions).default; + "th-compat".revision = (((hackage."th-compat")."0.1.1").revisions).default; + "data-default-class".revision = (((hackage."data-default-class")."0.1.2.0").revisions).default; + "terminfo".revision = (((hackage."terminfo")."0.4.1.4").revisions).default; + "base16-bytestring".revision = (((hackage."base16-bytestring")."1.0.1.0").revisions).default; + "vector-algorithms".revision = (((hackage."vector-algorithms")."0.8.0.4").revisions).default; + "vector-algorithms".flags.unsafechecks = false; + "vector-algorithms".flags.internalchecks = false; + "vector-algorithms".flags.llvm = false; + "vector-algorithms".flags.boundschecks = true; + "vector-algorithms".flags.bench = true; + "vector-algorithms".flags.properties = true; + "prettyprinter".revision = (((hackage."prettyprinter")."1.7.0").revisions).default; + "prettyprinter".flags.buildreadme = false; + "cryptohash-sha512".revision = (((hackage."cryptohash-sha512")."0.11.100.1").revisions).default; + "pretty-show".revision = (((hackage."pretty-show")."1.10").revisions).default; + "transformers".revision = (((hackage."transformers")."0.5.6.2").revisions).default; + "hashable".revision = (((hackage."hashable")."1.3.0.0").revisions).default; + "hashable".flags.sse2 = true; + "hashable".flags.integer-gmp = true; + "hashable".flags.sse41 = false; + "hashable".flags.examples = false; + "attoparsec".revision = (((hackage."attoparsec")."0.13.2.5").revisions).default; + "attoparsec".flags.developer = false; + "infer-license".revision = (((hackage."infer-license")."0.2.0").revisions).default; + "colour".revision = (((hackage."colour")."2.3.5").revisions).default; + "transformers-base".revision = (((hackage."transformers-base")."0.4.5.2").revisions).default; + "transformers-base".flags.orphaninstances = true; + "happy".revision = (((hackage."happy")."1.20.0").revisions).default; + "strict".revision = (((hackage."strict")."0.4.0.1").revisions).default; + "strict".flags.assoc = true; + "filepath".revision = (((hackage."filepath")."1.4.2.1").revisions).default; + "asn1-types".revision = (((hackage."asn1-types")."0.3.4").revisions).default; + "nix-derivation".revision = (((hackage."nix-derivation")."1.1.1").revisions).default; + "cborg".revision = (((hackage."cborg")."0.2.4.0").revisions).default; + "cborg".flags.optimize-gmp = true; + "gitrev".revision = (((hackage."gitrev")."1.3.1").revisions).default; + "monad-control".revision = (((hackage."monad-control")."1.0.2.3").revisions).default; + "process".revision = (((hackage."process")."1.6.9.0").revisions).default; + "tls".revision = (((hackage."tls")."1.5.5").revisions).default; + "tls".flags.compat = true; + "tls".flags.network = true; + "tls".flags.hans = false; + "kan-extensions".revision = (((hackage."kan-extensions")."5.2.2").revisions).default; + "libyaml".revision = (((hackage."libyaml")."0.1.2").revisions).default; + "libyaml".flags.system-libyaml = false; + "libyaml".flags.no-unicode = false; + "resourcet".revision = (((hackage."resourcet")."1.2.4.2").revisions).default; + "pretty".revision = (((hackage."pretty")."1.1.3.6").revisions).default; + "cabal-doctest".revision = (((hackage."cabal-doctest")."1.0.8").revisions).default; + "Glob".revision = (((hackage."Glob")."0.10.1").revisions).default; + "algebraic-graphs".revision = (((hackage."algebraic-graphs")."0.5").revisions).default; + "microlens".revision = (((hackage."microlens")."0.4.12.0").revisions).default; + "aeson".revision = (((hackage."aeson")."1.5.6.0").revisions).default; + "aeson".flags.cffi = false; + "aeson".flags.fast = false; + "aeson".flags.bytestring-builder = false; + "aeson".flags.developer = false; + "http-types".revision = (((hackage."http-types")."0.12.3").revisions).default; + "ghc-boot-th".revision = (((hackage."ghc-boot-th")."8.10.5").revisions).default; + "base-orphans".revision = (((hackage."base-orphans")."0.8.4").revisions).default; + "th-abstraction".revision = (((hackage."th-abstraction")."0.4.2.0").revisions).default; + "memory".revision = (((hackage."memory")."0.15.0").revisions).default; + "memory".flags.support_bytestring = true; + "memory".flags.support_basement = true; + "memory".flags.support_foundation = true; + "memory".flags.support_deepseq = true; + "array".revision = (((hackage."array")."0.5.4.0").revisions).default; + "repline".revision = (((hackage."repline")."0.4.0.0").revisions).default; + "xml".revision = (((hackage."xml")."1.3.14").revisions).default; + "lens-family-core".revision = (((hackage."lens-family-core")."2.1.0").revisions).default; + "integer-gmp".revision = (((hackage."integer-gmp")."1.0.3.0").revisions).default; + }; + compiler = { + version = "8.10.5"; + nix-name = "ghc8105"; + packages = { + "exceptions" = "0.10.4"; + "binary" = "0.8.8.0"; + "ghc-prim" = "0.6.1"; + "haskeline" = "0.8.0.1"; + "stm" = "2.5.0.1"; + "unix" = "2.7.2.2"; + "mtl" = "2.2.2"; + "rts" = "1.0.1"; + "deepseq" = "1.4.4.0"; + "parsec" = "3.1.14.0"; + "directory" = "1.3.6.0"; + "template-haskell" = "2.16.0.0"; + "containers" = "0.6.4.1"; + "bytestring" = "0.10.12.0"; + "text" = "1.2.4.1"; + "Cabal" = "3.2.1.0"; + "base" = "4.14.2.0"; + "time" = "1.9.3"; + "terminfo" = "0.4.1.4"; + "transformers" = "0.5.6.2"; + "filepath" = "1.4.2.1"; + "process" = "1.6.9.0"; + "pretty" = "1.1.3.6"; + "ghc-boot-th" = "8.10.5"; + "array" = "0.5.4.0"; + "integer-gmp" = "1.0.3.0"; + }; + }; + }; + extras = hackage: + { + packages = { + nix-tools = ./.plan.nix/nix-tools.nix; + hackage-db = ./.plan.nix/hackage-db.nix; + }; + }; + modules = [ + ({ lib, ... }: + { + packages = { + "nix-tools" = { flags = {}; }; + "hackage-db" = { + flags = { "install-examples" = lib.mkOverride 900 false; }; + }; + }; + }) + ]; + } \ No newline at end of file From fe69fdc81a120245c2c151f58612955ad815b709 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 9 Jun 2021 00:33:12 +1200 Subject: [PATCH 31/32] Add rts exports patch --- overlays/bootstrap.nix | 3 ++- .../ghc/ghc-8.10.5-add-rts-exports.patch | 26 +++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) create mode 100644 overlays/patches/ghc/ghc-8.10.5-add-rts-exports.patch diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index e893ce3ed0..fd0d5651e6 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -162,7 +162,8 @@ in { ++ final.lib.optional (versionAtLeast "8.6.5") ./patches/ghc/ghc-8.10-windows-add-dependent-file.patch ++ fromUntil "8.10.1" "9.0" ./patches/ghc/Cabal-unbreak-GHCJS.patch ++ until "8.10.5" ./patches/ghc/AC_PROG_CC_99.patch - ++ fromUntil "9.0.1" "9.0.2" ./patches/ghc/AC_PROG_CC_99.patch + ++ fromUntil "9.0.1" "9.0.2" ./patches/ghc/AC_PROG_CC_99.patch + ++ fromUntil "8.10.5" "9.0.2" ./patches/ghc/ghc-8.10.5-add-rts-exports.patch ; in ({ ghc844 = final.callPackage ../compiler/ghc { diff --git a/overlays/patches/ghc/ghc-8.10.5-add-rts-exports.patch b/overlays/patches/ghc/ghc-8.10.5-add-rts-exports.patch new file mode 100644 index 0000000000..eb7fe62cb2 --- /dev/null +++ b/overlays/patches/ghc/ghc-8.10.5-add-rts-exports.patch @@ -0,0 +1,26 @@ +diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c +index 9ca696c27c441059fb0fd82854e0737d5eccf2ad..d5b8cc5fece8395d277dd01cabdc309ac33406da 100644 +--- a/rts/RtsSymbols.c ++++ b/rts/RtsSymbols.c +@@ -539,11 +539,21 @@ + #define RTS_PROF_SYMBOLS /* empty */ + #endif + ++#if RTS_LINKER_USE_MMAP ++#define RTS_LINKER_USE_MMAP_SYMBOLS \ ++ SymI_HasProto(allocateWrite) \ ++ SymI_HasProto(freeWrite) \ ++ SymI_HasProto(markExec) ++#else ++#define RTS_LINKER_USE_MMAP_SYMBOLS /* empty */ ++#endif ++ + #define RTS_SYMBOLS \ + Maybe_Stable_Names \ + RTS_TICKY_SYMBOLS \ + RTS_PROF_SYMBOLS \ + RTS_LIBDW_SYMBOLS \ ++ RTS_LINKER_USE_MMAP_SYMBOLS \ + SymI_HasProto(StgReturn) \ + SymI_HasProto(stg_gc_noregs) \ + SymI_HasProto(stg_ret_v_info) \ From 3492e3485f3c948866fdf274dfd6125f21efaac0 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 9 Jun 2021 01:10:19 +1200 Subject: [PATCH 32/32] Don't path 9.0.1 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit rts/RtsSymbols.c:555:21: error: error: ‘allocateWrite’ undeclared here (not in a function) 555 | SymI_HasProto(allocateWrite) \ | ^~~~~~~~~~~~~ | 555 | SymI_HasProto(allocateWrite) \ | ^ --- overlays/bootstrap.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/overlays/bootstrap.nix b/overlays/bootstrap.nix index fd0d5651e6..75bba930ad 100644 --- a/overlays/bootstrap.nix +++ b/overlays/bootstrap.nix @@ -163,7 +163,7 @@ in { ++ fromUntil "8.10.1" "9.0" ./patches/ghc/Cabal-unbreak-GHCJS.patch ++ until "8.10.5" ./patches/ghc/AC_PROG_CC_99.patch ++ fromUntil "9.0.1" "9.0.2" ./patches/ghc/AC_PROG_CC_99.patch - ++ fromUntil "8.10.5" "9.0.2" ./patches/ghc/ghc-8.10.5-add-rts-exports.patch + ++ fromUntil "8.10.5" "8.10.6" ./patches/ghc/ghc-8.10.5-add-rts-exports.patch ; in ({ ghc844 = final.callPackage ../compiler/ghc {