Skip to content
Commits on Source (113)
# Questions about this file?
# See https://gitlab.haskell.org/ghc/ghc/wikis/continuous-integration/usage.
version: 2
aliases:
- &defaults
working_directory: ~/ghc
- &prepare
run:
name: prepare-system
command: .circleci/prepare-system.sh
- &submodules
run:
name: submodules
command: .circleci/fetch-submodules.sh
- &buildenv
# ideally we would simply set THREADS here instead of re-detecting it every
# time we need it below. Unfortunately, there is no way to set an environment
# variable with the result of a shell script.
SKIP_PERF_TESTS: NO
VERBOSE: 2
- &boot
run:
name: Boot
command: |
./boot
- &set_git_identity
run:
name: Set Git Identity
command: |
git config user.email "ghc-circleci@haskell.org"
git config user.name "GHC CircleCI"
- &configure_unix
run:
name: Configure
command: ./configure
- &configure_unix_32
run:
name: Configure
command: |
setarch i386 ./configure --with-ghc=/opt/ghc-i386/8.4.2/bin/ghc
- &configure_bsd
run:
name: Configure
command: ./configure --target=x86_64-unknown-freebsd10
- &configure_unreg
run:
name: Configure
command: ./configure --enable-unregisterised
- &make
run:
name: Build
command: "make -j`mk/detect-cpu-count.sh` V=0"
- &build_hadrian
run:
name: Build GHC using Hadrian
command: |
cabal update
hadrian/build.sh -j`mk/detect-cpu-count.sh`
- &test
run:
name: Test
command: |
mkdir -p test-results
METRICS_FILE=$(mktemp)
echo "export METRICS_FILE=$METRICS_FILE" >> $BASH_ENV
make test THREADS=`mk/detect-cpu-count.sh` SKIP_PERF_TESTS=$SKIP_PERF_TESTS TEST_ENV=$TEST_ENV JUNIT_FILE=../../test-results/junit.xml METRICS_FILE=$METRICS_FILE
- &store_test_results
store_test_results:
path: test-results
- &push_perf_note
run:
name: Push Performance Git Notes
command: .circleci/push-test-metrics.sh
- &store_test_artifacts
store_artifacts:
# we might want to add the whole output of the test phase
# too at some point
path: test-results/junit.xml
- &slowtest
run:
name: Full Test
command: |
mkdir -p test-results
make slowtest SKIP_PERF_TESTS=YES THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../test-results/junit.xml
- &bindist
run:
name: Create bindist
# Reduce compression effort to 3
command: make binary-dist TAR_COMP_OPTS="-2" && mv ghc*.tar.xz ghc.tar.xz
# Building bindist takes ~15 minutes without output, account for
# that.
no_output_timeout: "30m"
- &store_bindist
store_artifacts:
path: ghc.tar.xz
- &only_release_tags
tags:
only: /^ghc-.*/
- &ignore_gitlab_branches
branches:
ignore: /^gitlab\/.*/
jobs:
"validate-x86_64-freebsd":
docker:
- image: ghcci/x86_64-freebsd
environment:
TARGET: FreeBSD
<<: *buildenv
GHC_COLLECTOR_FLAVOR: x86_64-freebsd
TEST_ENV: x86_64-freebsd
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_bsd
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-x86_64-darwin":
macos:
xcode: "9.0"
environment:
# Disable sphinx PDF output as MacTeX apparently doesn't provide xelatex
BUILD_SPHINX_PDF: "NO"
MACOSX_DEPLOYMENT_TARGET: "10.7"
# Only Sierra and onwards supports clock_gettime. See #12858
ac_cv_func_clock_gettime: "no"
GHC_COLLECTOR_FLAVOR: x86_64-darwin
<<: *buildenv
TEST_ENV: x86_64-darwin
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-x86_64-linux-deb8":
docker:
- image: ghcci/x86_64-linux-deb8:0.1
environment:
<<: *buildenv
GHC_COLLECTOR_FLAVOR: x86_64-linux
TEST_ENV: x86_64-linux-deb8
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-x86_64-linux-deb9-integer-simple":
docker:
- image: ghcci/x86_64-linux-deb9:0.2
environment:
<<: *buildenv
INTEGER_LIBRARY: integer-simple
GHC_COLLECTOR_FLAVOR: x86_64-linux-deb9
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-x86_64-linux-deb9":
docker:
- image: ghcci/x86_64-linux-deb9:0.1
environment:
<<: *buildenv
GHC_COLLECTOR_FLAVOR: x86_64-linux-deb9
TEST_ENV: x86_64-linux-deb9
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-hadrian-x86_64-linux-deb8":
docker:
- image: ghcci/x86_64-linux-deb8:0.1
environment:
<<: *buildenv
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *build_hadrian
"validate-x86_64-linux-deb8-unreg":
docker:
- image: ghcci/x86_64-linux-deb8:0.1
environment:
<<: *buildenv
TEST_ENV: x86_64-linux-deb8-unreg
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unreg
- *make
- *test
- *store_test_results
- *push_perf_note
- *store_test_artifacts
"validate-x86_64-linux-deb9-llvm":
docker:
- image: ghcci/x86_64-linux-deb9:0.2
environment:
<<: *buildenv
BUILD_FLAVOUR: perf-llvm
TEST_ENV: x86_64-linux-deb9-llvm
steps:
- run:
name: Verify that llc works
command: llc
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
# Nightly build with -DDEBUG using devel2 flavour
"validate-x86_64-linux-deb8-debug":
docker:
- image: ghcci/x86_64-linux-deb8:0.1
environment:
BUILD_FLAVOUR: devel2
<<: *buildenv
TEST_ENV: x86_64-linux-deb8-debug
SKIP_PERF_TESTS: YES
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-i386-linux-deb9":
docker:
- image: ghcci/i386-linux-deb9:0.2
environment:
<<: *buildenv
GHC_COLLECTOR_FLAVOR: i386-linux-deb9
TEST_ENV: i386-linux-deb9
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix_32
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-i386-linux-deb8":
docker:
- image: ghcci/i386-linux-deb8:0.1
environment:
<<: *buildenv
GHC_COLLECTOR_FLAVOR: i386-linux
TEST_ENV: i386-linux-deb8
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix_32
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-x86_64-linux-centos7":
docker:
- image: ghcci/x86_64-linux-centos7:0.1
environment:
<<: *buildenv
GHC_COLLECTOR_FLAVOR: x86_64-centos7
LANG: en_US.UTF-8
TEST_ENV: x86_64-centos7
# Sphinx is too old
BUILD_SPHINX_PDF: NO
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"validate-x86_64-linux-fedora27":
docker:
- image: ghcci/x86_64-linux-fedora27:0.1
environment:
<<: *buildenv
GHC_COLLECTOR_FLAVOR: x86_64-fedora
TEST_ENV: x86_64-linux-fedora27
steps:
- checkout
- *set_git_identity
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *bindist
- *store_bindist
- *test
- *store_test_results
- *store_test_artifacts
- *push_perf_note
"slow-validate-x86_64-linux-deb8":
docker:
- image: ghcci/x86_64-linux-deb8:0.1
environment:
<<: *buildenv
GHC_COLLECTOR_FLAVOR: x86_64-linux-deb8
steps:
- checkout
- *prepare
- *submodules
- *boot
- *configure_unix
- *make
- *slowtest
- *store_test_results
- *store_test_artifacts
- *push_perf_note
workflows:
version: 2
validate:
jobs:
- validate-x86_64-linux-deb8:
filters:
<<: [*only_release_tags, *ignore_gitlab_branches]
# FreeBSD disabled: https://github.com/haskell/unix/issues/102
# - validate-x86_64-freebsd
- validate-x86_64-darwin:
filters:
<<: [*only_release_tags, *ignore_gitlab_branches]
- validate-x86_64-linux-deb8-llvm:
filters:
<<: *ignore_gitlab_branches
- validate-i386-linux-deb8:
filters:
<<: [*only_release_tags, *ignore_gitlab_branches]
- validate-x86_64-linux-deb9:
filters:
<<: [*only_release_tags, *ignore_gitlab_branches]
- validate-i386-linux-deb9:
filters:
<<: [*only_release_tags, *ignore_gitlab_branches]
- validate-x86_64-linux-centos7:
filters:
<<: [*only_release_tags, *ignore_gitlab_branches]
- validate-hadrian-x86_64-linux-deb8:
filters:
<<: *ignore_gitlab_branches
- validate-x86_64-linux-fedora27:
filters:
<<: [*only_release_tags, *ignore_gitlab_branches]
nightly:
triggers:
- schedule:
cron: "0 0 * * *"
filters:
branches:
only:
- master
jobs:
- validate-x86_64-linux-deb8-unreg
- validate-x86_64-linux-deb8-llvm
- validate-x86_64-linux-deb8-debug
- validate-x86_64-linux-deb9
- validate-x86_64-linux-deb9-integer-simple
- slow-validate-x86_64-linux-deb8
notify:
webhooks:
- url: https://phabricator.haskell.org/harbormaster/hook/circleci/
#!/usr/bin/env bash
set -euo pipefail
# Use github.com/ghc for those submodule repositories we couldn't connect to.
git config remote.origin.url git://github.com/ghc/ghc.git
git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/
git submodule init # Don't be quiet, we want to show these urls.
git submodule --quiet update --recursive # Now we can be quiet again.
#!/usr/bin/env bash
# vim: sw=2 et
set -euo pipefail
fail() {
echo "ERROR: $*" >&2
exit 1
}
if [ "$CIRCLE_REPOSITORY_URL" != "git@github.com:ghc/ghc.git" ]; then
exit 0
fi
GHC_ORIGIN=git@git.haskell.org:ghc
# Add git.haskell.org as a known host.
echo "|1|F3mPVCE55+KfApNIMYQ3Dv39sGE=|1bRkvJEJhAN2R0LE/lAjFCEJGl0= ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBBUZS9jGBkE5UzpSo6irnIgcQcfzvbuIOsFc8+N61FwtZncRntbaKPuUimOFPgeaUZLl6Iajz6IIs7aduU0/v+I=" >> ~/.ssh/known_hosts
echo "|1|2VUMjYSRVpT2qJPA0rA9ap9xILY=|5OThkI4ED9V0J+Es7D5FOD55Klk= ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC+3TLluLAO4lkW60W+N2DFkS+WoRFGqLwHzgd1ifxG9TIm31wChPY3E/hgMnJmgGqWCF4UDUemmyCycEaL7FtKfzjTAclg9EfpQnozyE3T5hIo2WL7SN5O8ttG/bYGuDnn14jLnWwJyN4oz/znWFiDG9e2Oc9YFNlQ+PK8ae5xR4gqBB7EOoj9J1EiPqG2OXRr5Mei3TLsRDU6fnz/e4oFJpKWWeN6M63oePv0qoaGjxcrATZUWsuWrxVMmYo9kP1xRuFJbAUw2m4uVP+793SW1zxySi1HBMtJG+gCDdZZSwYbkV1hassLWBHv1qPttncfX8Zek3Z3VolaTmfWJTo9" >> ~/.ssh/known_hosts
# Check that a git notes dont already exist.
# This is a percausion as we reset refs/notes/perf and we want to avoid data loss.
if [ $(git notes --ref=perf list | wc -l) -ne 0 ]
then
fail "Found an existing git note on HEAD. Expected no git note."
fi
# Assert that the METRICS_FILE exists and can be read.
if [ "$METRICS_FILE" = "" ] || ! [ -r $METRICS_FILE ]
then
fail "Metrics file not found: $METRICS_FILE"
fi
# Reset the git notes and append the metrics file to the notes, then push and return the result.
# This is favoured over a git notes merge as it avoids potential data loss/duplication from the merge strategy.
function reset_append_note_push {
git fetch -f $GHC_ORIGIN refs/notes/perf:refs/notes/perf || true
echo "git notes --ref=perf append -F $METRICS_FILE HEAD"
git notes --ref=perf append -F $METRICS_FILE HEAD
git push $GHC_ORIGIN refs/notes/perf
}
# Push the metrics file as a git note. This may fail if another task pushes a note first. In that case
# the latest note is fetched and appended.
MAX_RETRY=20
until reset_append_note_push || [ $MAX_RETRY -le 0 ]
do
((MAX_RETRY--))
echo ""
echo "Failed to push git notes. Fetching, appending, and retrying... $MAX_RETRY retries left."
done
......@@ -2,12 +2,15 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
DOCKER_REV: ac65f31dcffb09cd7ca7aaa70f447fcbb19f427f
DOCKER_REV: 88e952f165f48cfb956ac9a2486a9263aa4f777c
# Sequential version number capturing the versions of all tools fetched by
# .gitlab/win32-init.sh.
WINDOWS_TOOLCHAIN_VERSION: 1
# Disable shallow clones; they break our linting rules
GIT_DEPTH: 0
before_script:
- python3 .gitlab/fix-submodules.py
- git submodule sync --recursive
......@@ -49,13 +52,12 @@ stages:
############################################################
ghc-linters:
allow_failure: true
stage: lint
image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
script:
- git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME
- base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)"
- "echo Merge base $base"
- "echo Linting changes between $base..$CI_COMMIT_SHA"
# - validate-commit-msg .git $(git rev-list $base..$CI_COMMIT_SHA)
- validate-whitespace .git $(git rev-list $base..$CI_COMMIT_SHA)
- .gitlab/linters/check-makefiles.py $base $CI_COMMIT_SHA
......@@ -75,18 +77,15 @@ ghc-linters:
stage: lint
image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
script:
- git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME
- base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)"
- "echo Linting submodule changes between $base..$CI_COMMIT_SHA"
- git submodule foreach git remote update
- submodchecker .git $(git rev-list $base..$CI_COMMIT_SHA)
dependencies: []
tags:
- lint
lint-submods:
extends: .lint-submods
only:
refs:
- master
- /ghc-[0-9]+\.[0-9]+/
lint-submods-marge:
extends: .lint-submods
only:
......@@ -97,10 +96,26 @@ lint-submods-marge:
lint-submods-mr:
extends: .lint-submods
# Allow failure since any necessary submodule patches may not be upstreamed
# yet.
allow_failure: true
only:
refs:
- merge_requests
except:
variables:
- $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/
lint-submods-branch:
extends: .lint-submods
script:
- "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA"
- git submodule foreach git remote update
- submodchecker .git $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA)
only:
refs:
- master
- /ghc-[0-9]+\.[0-9]+/
.lint-changelogs:
stage: lint
......@@ -117,6 +132,7 @@ lint-submods-mr:
lint-changelogs:
extends: .lint-changelogs
# Allow failure since this isn't a final release.
allow_failure: true
only:
refs:
......@@ -135,11 +151,10 @@ lint-release-changelogs:
.validate-hadrian:
<<: *only-default
allow_failure: true
script:
- cabal update
- git clean -xdf && git submodule foreach git clean -xdf
- bash .circleci/prepare-system.sh
- .gitlab/prepare-system.sh
- if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi
- ./boot
- ./configure $CONFIGURE_ARGS
......@@ -158,10 +173,10 @@ lint-release-changelogs:
- ghc.tar.xz
- junit.xml
validate-x86_64-linux-deb8-hadrian:
validate-x86_64-linux-deb9-hadrian:
extends: .validate-hadrian
stage: build
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV"
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
before_script:
# workaround for docker permissions
- sudo chown ghc:ghc -R .
......@@ -176,7 +191,7 @@ validate-x86_64-linux-deb8-hadrian:
hadrian-ghc-in-ghci:
<<: *only-default
stage: build
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb8:$DOCKER_REV"
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
before_script:
# workaround for docker permissions
- sudo chown ghc:ghc -R .
......@@ -190,7 +205,7 @@ hadrian-ghc-in-ghci:
- cabal update
- cd hadrian; cabal new-build --project-file=ci.project; cd ..
- git clean -xdf && git submodule foreach git clean -xdf
- bash .circleci/prepare-system.sh
- .gitlab/prepare-system.sh
- if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi
- ./boot
- ./configure $CONFIGURE_ARGS
......@@ -217,6 +232,8 @@ hadrian-ghc-in-ghci:
- |
THREADS=`mk/detect-cpu-count.sh`
make V=0 -j$THREADS WERROR=-Werror
- |
make bindisttest
- |
make binary-dist TAR_COMP_OPTS="-1"
- |
......@@ -278,6 +295,47 @@ validate-x86_64-darwin:
- cabal-cache
- toolchain
# Disabled because of OS X CI capacity
.validate-x86_64-darwin-hadrian:
<<: *only-default
stage: full-build
tags:
- x86_64-darwin
variables:
GHC_VERSION: 8.6.3
MACOSX_DEPLOYMENT_TARGET: "10.7"
ac_cv_func_clock_gettime: "no"
LANG: "en_US.UTF-8"
CONFIGURE_ARGS: --with-intree-gmp
TEST_ENV: "x86_64-darwin"
before_script:
- git clean -xdf && git submodule foreach git clean -xdf
- python3 .gitlab/fix-submodules.py
- git submodule sync --recursive
- git submodule update --init --recursive
- git checkout .gitmodules
- "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true"
- bash .gitlab/darwin-init.sh
- PATH="`pwd`/toolchain/bin:$PATH"
script:
- cabal update
- ./boot
- ./configure $CONFIGURE_ARGS
- hadrian/build.cabal.sh -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist
- hadrian/build.cabal.sh -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml
- mv _build/bindist/ghc*.tar.xz ghc.tar.xz
after_script:
- cp -Rf $HOME/.cabal cabal-cache
artifacts:
when: always
expire_in: 2 week
reports:
junit: junit.xml
paths:
- ghc.tar.xz
- junit.xml
.validate-linux:
extends: .validate
tags:
......@@ -295,7 +353,7 @@ validate-x86_64-darwin:
echo "EXTRA_HADDOCK_OPTS += --hyperlinked-source --quickjump" >> mk/build.mk
fi
- bash .circleci/prepare-system.sh
- .gitlab/prepare-system.sh
# workaround for docker permissions
- sudo chown ghc:ghc -R .
after_script:
......@@ -318,6 +376,8 @@ validate-x86_64-darwin:
variables:
TEST_ENV: "aarch64-linux-deb9"
BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-aarch64-linux-deb9.tar.xz"
# Inexplicably makeindex fails
BUILD_SPHINX_PDF: "NO"
cache:
key: linux-aarch64-deb9
tags:
......@@ -384,7 +444,8 @@ nightly-i386-linux-deb9:
cache:
key: linux-x86_64-deb9
validate-x86_64-linux-deb9:
# Disabled to reduce CI load
.validate-x86_64-linux-deb9:
extends: .build-x86_64-linux-deb9
artifacts:
when: always
......@@ -406,15 +467,30 @@ validate-x86_64-linux-deb9-debug:
stage: build
variables:
BUILD_FLAVOUR: validate
TEST_TYPE: slowtest
TEST_ENV: "x86_64-linux-deb9-debug"
artifacts:
when: always
expire_in: 2 week
validate-x86_64-linux-deb9-llvm:
# Disabled to alleviate CI load
.validate-x86_64-linux-deb9-llvm:
extends: .build-x86_64-linux-deb9
stage: full-build
variables:
BUILD_FLAVOUR: perf-llvm
TEST_ENV: "x86_64-linux-deb9-llvm"
nightly-x86_64-linux-deb9-llvm:
extends: .build-x86_64-linux-deb9
stage: full-build
variables:
BUILD_FLAVOUR: perf-llvm
TEST_ENV: "x86_64-linux-deb9-llvm"
only:
variables:
- $NIGHTLY
validate-x86_64-linux-deb9-integer-simple:
extends: .build-x86_64-linux-deb9
stage: full-build
......@@ -610,6 +686,7 @@ nightly-i386-windows-hadrian:
- bash -c "echo include mk/flavours/${BUILD_FLAVOUR}.mk > mk/build.mk"
- bash -c "echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk"
- bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`"
- bash -c "PATH=`pwd`/toolchain/bin:$PATH make bindisttest"
- bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist TAR_COMP_OPTS=-1"
- bash -c 'make V=0 test THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml'
tags:
......@@ -718,7 +795,7 @@ doc-tarball:
- x86_64-linux
image: ghcci/x86_64-linux-deb9:0.2
dependencies:
- validate-x86_64-linux-deb9
- validate-x86_64-linux-deb9-debug
- validate-x86_64-windows
variables:
LINUX_BINDIST: "ghc-x86_64-deb9-linux.tar.xz"
......@@ -820,6 +897,12 @@ pages:
- tar -xf haddock.html.tar.xz -C public/doc
- tar -xf libraries.html.tar.xz -C public/doc
- tar -xf users_guide.html.tar.xz -C public/doc
- |
cat >public/index.html <<EOF
<!DOCTYPE HTML>
<meta charset="UTF-8">
<meta http-equiv="refresh" content="1; url=doc/">
EOF
- cp -f index.html public/doc
only:
- master
......
......@@ -12,7 +12,8 @@ from linter import run_linters, RegexpLinter
linters = [
RegexpLinter(r'--interactive',
message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.")
message = "Warning: Use `$(TEST_HC_OPTS_INTERACTIVE)` instead of `--interactive -ignore-dot-ghci -v0`.",
path_filter = lambda path: path == 'Makefile')
]
if __name__ == '__main__':
......
......@@ -73,13 +73,14 @@ class RegexpLinter(LineLinter):
A :class:`RegexpLinter` produces the given warning message for
all lines matching the given regular expression.
"""
def __init__(self, regex, message):
def __init__(self, regex, message, path_filter=lambda path: True):
LineLinter.__init__(self)
self.re = re.compile(regex)
self.message = message
self.path_filter = path_filter
def lint_line(self, path, line_no, line):
if self.re.search(line):
if self.path_filter(path) and self.re.search(line):
w = Warning(path=path, line_no=line_no, line_content=line[:-1],
message=self.message)
self.add_warning(w)
......
......@@ -866,7 +866,7 @@ case $TargetPlatform in
esac ;;
i386-unknown-mingw32) fptools_cv_leading_underscore=yes;;
x86_64-unknown-mingw32) fptools_cv_leading_underscore=no;;
*) AC_RUN_IFELSE([AC_LANG_SOURCE([[#ifdef HAVE_NLIST_H
*) AC_RUN_IFELSE([AC_LANG_SOURCE([[#if defined(HAVE_NLIST_H)
#include <nlist.h>
struct nlist xYzzY1[] = {{"xYzzY1", 0},{0}};
struct nlist xYzzY2[] = {{"_xYzzY2", 0},{0}};
......@@ -876,7 +876,7 @@ int main(argc, argv)
int argc;
char **argv;
{
#ifdef HAVE_NLIST_H
#if defined(HAVE_NLIST_H)
if(nlist(argv[0], xYzzY1) == 0 && xYzzY1[0].n_value != 0)
exit(1);
if(nlist(argv[0], xYzzY2) == 0 && xYzzY2[0].n_value != 0)
......@@ -1650,16 +1650,16 @@ then
[fptools_cv_timer_create_works],
[AC_TRY_RUN([
#include <stdio.h>
#ifdef HAVE_STDLIB_H
#if defined(HAVE_STDLIB_H)
#include <stdlib.h>
#endif
#ifdef HAVE_TIME_H
#if defined(HAVE_TIME_H)
#include <time.h>
#endif
#ifdef HAVE_SIGNAL_H
#if defined(HAVE_SIGNAL_H)
#include <signal.h>
#endif
#ifdef HAVE_UNISTD_H
#if defined(HAVE_UNISTD_H)
#include <unistd.h>
#endif
......
......@@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the
predicate (C a). But now we treat that as an ordinary argument, not
part of the theta-type, so all is well.
Note [Newtype workers]
~~~~~~~~~~~~~~~~~~~~~~
A newtype does not really have a worker. Instead, newtype constructors
just unfold into a cast. But we need *something* for, say, MkAge to refer
to. So, we do this:
* The Id used as the newtype worker will have a compulsory unfolding to
a cast. See Note [Compulsory newtype unfolding]
* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId,
as those have special treatment in the back end.
* There is no top-level binding, because the compulsory unfolding
means that it will be inlined (to a cast) at every call site.
We probably should have a NewtypeWorkId, but these Ids disappear as soon as
we desugar anyway, so it seems a step too far.
Note [Compulsory newtype unfolding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Newtype wrappers, just like workers, have compulsory unfoldings.
......@@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id
mkDataConWorkId wkr_name data_con
| isNewTyCon tycon
= mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info
-- See Note [Newtype workers]
| otherwise
= mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info
......
......@@ -25,6 +25,7 @@ module NameEnv (
emptyDNameEnv,
lookupDNameEnv,
delFromDNameEnv,
mapDNameEnv,
alterDNameEnv,
-- ** Dependency analysis
......@@ -147,6 +148,9 @@ emptyDNameEnv = emptyUDFM
lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
lookupDNameEnv = lookupUDFM
delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a
delFromDNameEnv = delFromUDFM
mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
mapDNameEnv = mapUDFM
......
......@@ -4,6 +4,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE PatternSynonyms #-}
#if !defined(GHC_LOADED_INTO_GHCI)
......@@ -148,20 +149,18 @@ pattern UniqResult x y = (# x, y #)
#else
data UniqResult result = UniqResult !result {-# UNPACK #-} !UniqSupply
deriving (Functor)
#endif
-- | A monad which just gives the ability to obtain 'Unique's
newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result }
deriving (Functor)
instance Monad UniqSM where
(>>=) = thenUs
(>>) = (*>)
instance Functor UniqSM where
fmap f (USM x) = USM (\us0 -> case x us0 of
UniqResult r us1 -> UniqResult (f r) us1)
instance Applicative UniqSM where
pure = returnUs
(USM f) <*> (USM x) = USM $ \us0 -> case f us0 of
......
......@@ -5,6 +5,7 @@
-- CmmLint: checking the correctness of Cmm statements and expressions
--
-----------------------------------------------------------------------------
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
module CmmLint (
cmmLint, cmmLintGraph
......@@ -24,7 +25,7 @@ import PprCmm ()
import Outputable
import DynFlags
import Control.Monad (liftM, ap)
import Control.Monad (ap)
-- Things to check:
-- - invariant on CmmBlock in CmmExpr (see comment there)
......@@ -212,9 +213,7 @@ checkCond _ expr
-- just a basic error monad:
newtype CmmLint a = CmmLint { unCL :: DynFlags -> Either SDoc a }
instance Functor CmmLint where
fmap = liftM
deriving (Functor)
instance Applicative CmmLint where
pure a = CmmLint (\_ -> Right a)
......
......@@ -556,7 +556,9 @@ data CallishMachOp
| MO_F64_Acosh
| MO_F64_Atanh
| MO_F64_Log
| MO_F64_Log1P
| MO_F64_Exp
| MO_F64_ExpM1
| MO_F64_Fabs
| MO_F64_Sqrt
| MO_F32_Pwr
......@@ -573,7 +575,9 @@ data CallishMachOp
| MO_F32_Acosh
| MO_F32_Atanh
| MO_F32_Log
| MO_F32_Log1P
| MO_F32_Exp
| MO_F32_ExpM1
| MO_F32_Fabs
| MO_F32_Sqrt
......
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE StandaloneDeriving #-}
module Hoopl.Block
( C
, O
......@@ -64,14 +66,8 @@ data MaybeC ex t where
JustC :: t -> MaybeC C t
NothingC :: MaybeC O t
instance Functor (MaybeO ex) where
fmap _ NothingO = NothingO
fmap f (JustO a) = JustO (f a)
instance Functor (MaybeC ex) where
fmap _ NothingC = NothingC
fmap f (JustC a) = JustC (f a)
deriving instance Functor (MaybeO ex)
deriving instance Functor (MaybeC ex)
-- -----------------------------------------------------------------------------
-- The Block type
......
......@@ -335,8 +335,8 @@ copyIn dflags conv area formals extra_stk
local = CmmLocal reg
width = cmmRegWidth dflags local
expr = CmmMachOp (MO_XX_Conv (wordWidth dflags) width) [stack_slot]
in CmmAssign local expr
in CmmAssign local expr
| otherwise =
CmmAssign (CmmLocal reg) (CmmLoad (CmmStackSlot area off) ty)
where ty = localRegType reg
......
{-# LANGUAGE CPP, GADTs #-}
{-# LANGUAGE CPP, DeriveFunctor, GADTs, PatternSynonyms #-}
-----------------------------------------------------------------------------
--
......@@ -61,7 +61,7 @@ import Data.Map (Map)
import Data.Word
import System.IO
import qualified Data.Map as Map
import Control.Monad (liftM, ap)
import Control.Monad (ap)
import qualified Data.Array.Unsafe as U ( castSTUArray )
import Data.Array.ST
......@@ -788,7 +788,9 @@ pprCallishMachOp_for_C mop
MO_F64_Acosh -> text "acosh"
MO_F64_Atan -> text "atan"
MO_F64_Log -> text "log"
MO_F64_Log1P -> text "log1p"
MO_F64_Exp -> text "exp"
MO_F64_ExpM1 -> text "expm1"
MO_F64_Sqrt -> text "sqrt"
MO_F64_Fabs -> text "fabs"
MO_F32_Pwr -> text "powf"
......@@ -805,7 +807,9 @@ pprCallishMachOp_for_C mop
MO_F32_Acosh -> text "acoshf"
MO_F32_Atanh -> text "atanhf"
MO_F32_Log -> text "logf"
MO_F32_Log1P -> text "log1pf"
MO_F32_Exp -> text "expf"
MO_F32_ExpM1 -> text "expm1f"
MO_F32_Sqrt -> text "sqrtf"
MO_F32_Fabs -> text "fabsf"
MO_WriteBarrier -> text "write_barrier"
......@@ -1078,10 +1082,7 @@ pprExternDecl lbl
<> semi
type TEState = (UniqSet LocalReg, Map CLabel ())
newtype TE a = TE { unTE :: TEState -> (a, TEState) }
instance Functor TE where
fmap = liftM
newtype TE a = TE { unTE :: TEState -> (a, TEState) } deriving (Functor)
instance Applicative TE where
pure a = TE $ \s -> (a, s)
......
......@@ -577,7 +577,7 @@ isSimpleScrut _ _ = return False
isSimpleOp :: StgOp -> [StgArg] -> FCode Bool
-- True iff the op cannot block or allocate
isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSafe safe)
isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _ _) _ = return $! not (playSafe safe)
-- dataToTag# evalautes its argument, see Note [dataToTag#] in primops.txt.pp
isSimpleOp (StgPrimOp DataToTagOp) _ = return False
isSimpleOp (StgPrimOp op) stg_args = do
......
{-# LANGUAGE DeriveFunctor #-}
-- | Our extended FCode monad.
-- We add a mapping from names to CmmExpr, to support local variable names in
......@@ -53,7 +54,7 @@ import UniqFM
import Unique
import UniqSupply
import Control.Monad (liftM, ap)
import Control.Monad (ap)
-- | The environment contains variable definitions or blockids.
data Named
......@@ -73,6 +74,7 @@ type Decls = [(FastString,Named)]
-- and a list of local declarations. Returns the resulting list of declarations.
newtype CmmParse a
= EC { unEC :: String -> Env -> Decls -> FCode (Decls, a) }
deriving (Functor)
type ExtCode = CmmParse ()
......@@ -82,9 +84,6 @@ returnExtFC a = EC $ \_ _ s -> return (s, a)
thenExtFC :: CmmParse a -> (a -> CmmParse b) -> CmmParse b
thenExtFC (EC m) k = EC $ \c e s -> do (s',r) <- m c e s; unEC (k r) c e s'
instance Functor CmmParse where
fmap = liftM
instance Applicative CmmParse where
pure = returnExtFC
(<*>) = ap
......
......@@ -34,7 +34,6 @@ import CmmUtils
import MkGraph
import Type
import RepType
import TysPrim
import CLabel
import SMRep
import ForeignCall
......@@ -44,20 +43,26 @@ import Outputable
import UniqSupply
import BasicTypes
import TyCoRep
import TysPrim
import Util (zipEqual)
import Control.Monad
-----------------------------------------------------------------------------
-- Code generation for Foreign Calls
-----------------------------------------------------------------------------
-- | emit code for a foreign call, and return the results to the sequel.
--
-- | Emit code for a foreign call, and return the results to the sequel.
-- Precondition: the length of the arguments list is the same as the
-- arity of the foreign function.
cgForeignCall :: ForeignCall -- the op
-> Type -- type of foreign function
-> [StgArg] -- x,y arguments
-> Type -- result type
-> FCode ReturnKind
cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty
cgForeignCall (CCall (CCallSpec target cconv safety)) typ stg_args res_ty
= do { dflags <- getDynFlags
; let -- in the stdcall calling convention, the symbol needs @size appended
-- to it, where size is the total number of bytes of arguments. We
......@@ -70,7 +75,7 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty
-- ToDo: this might not be correct for 64-bit API
arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType dflags arg)
(wORD_SIZE dflags)
; cmm_args <- getFCallArgs stg_args
; cmm_args <- getFCallArgs stg_args typ
; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty
; let ((call_args, arg_hints), cmm_target)
= case target of
......@@ -492,43 +497,128 @@ stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags)
closureField :: DynFlags -> ByteOff -> ByteOff
closureField dflags off = off + fixedHdrSize dflags
-- -----------------------------------------------------------------------------
-- Note [Unlifted boxed arguments to foreign calls]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- For certain types passed to foreign calls, we adjust the actual
-- value passed to the call. For ByteArray#/Array# we pass the
-- address of the actual array, not the address of the heap object.
getFCallArgs :: [StgArg] -> FCode [(CmmExpr, ForeignHint)]
-- value passed to the call. For ByteArray#, Array#, SmallArray#,
-- and ArrayArray#, we pass the address of the array's payload, not
-- the address of the heap object. For example, consider
-- foreign import "c_foo" foo :: ByteArray# -> Int# -> IO ()
-- At a Haskell call like `foo x y`, we'll generate a C call that
-- is more like
-- c_foo( x+8, y )
-- where the "+8" takes the heap pointer (x :: ByteArray#) and moves
-- it past the header words of the ByteArray object to point directly
-- to the data inside the ByteArray#. (The exact offset depends
-- on the target architecture and on profiling) By contrast, (y :: Int#)
-- requires no such adjustment.
--
-- This adjustment is performed by 'add_shim'. The size of the
-- adjustment depends on the type of heap object. But
-- how can we determine that type? There are two available options.
-- We could use the types of the actual values that the foreign call
-- has been applied to, or we could use the types present in the
-- foreign function's type. Prior to GHC 8.10, we used the former
-- strategy since it's a little more simple. However, in issue #16650
-- and more compellingly in the comments of
-- https://gitlab.haskell.org/ghc/ghc/merge_requests/939, it was
-- demonstrated that this leads to bad behavior in the presence
-- of unsafeCoerce#. Returning to the above example, suppose the
-- Haskell call looked like
-- foo (unsafeCoerce# p)
-- where the types of expressions comprising the arguments are
-- p :: (Any :: TYPE 'UnliftedRep)
-- i :: Int#
-- so that the unsafe-coerce is between Any and ByteArray#.
-- These two types have the same kind (they are both represented by
-- a heap pointer) so no GC errors will occur if we do this unsafe coerce.
-- By the time this gets to the code generator the cast has been
-- discarded so we have
-- foo p y
-- But we *must* adjust the pointer to p by a ByteArray# shim,
-- *not* by an Any shim (the Any shim involves no offset at all).
--
-- To avoid this bad behavior, we adopt the second strategy: use
-- the types present in the foreign function's type.
-- In collectStgFArgTypes, we convert the foreign function's
-- type to a list of StgFArgType. Then, in add_shim, we interpret
-- these as numeric offsets.
getFCallArgs ::
[StgArg]
-> Type -- the type of the foreign function
-> FCode [(CmmExpr, ForeignHint)]
-- (a) Drop void args
-- (b) Add foreign-call shim code
-- It's (b) that makes this differ from getNonVoidArgAmodes
getFCallArgs args
= do { mb_cmms <- mapM get args
-- Precondition: args and typs have the same length
-- See Note [Unlifted boxed arguments to foreign calls]
getFCallArgs args typ
= do { mb_cmms <- mapM get (zipEqual "getFCallArgs" args (collectStgFArgTypes typ))
; return (catMaybes mb_cmms) }
where
get arg | null arg_reps
= return Nothing
| otherwise
= do { cmm <- getArgAmode (NonVoid arg)
; dflags <- getDynFlags
; return (Just (add_shim dflags arg_ty cmm, hint)) }
where
arg_ty = stgArgType arg
arg_reps = typePrimRep arg_ty
hint = typeForeignHint arg_ty
add_shim :: DynFlags -> Type -> CmmExpr -> CmmExpr
add_shim dflags arg_ty expr
| tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
= cmmOffsetB dflags expr (arrPtrsHdrSize dflags)
| tycon == smallArrayPrimTyCon || tycon == smallMutableArrayPrimTyCon
= cmmOffsetB dflags expr (smallArrPtrsHdrSize dflags)
| tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
= cmmOffsetB dflags expr (arrWordsHdrSize dflags)
| otherwise = expr
get (arg,typ)
| null arg_reps
= return Nothing
| otherwise
= do { cmm <- getArgAmode (NonVoid arg)
; dflags <- getDynFlags
; return (Just (add_shim dflags typ cmm, hint)) }
where
arg_ty = stgArgType arg
arg_reps = typePrimRep arg_ty
hint = typeForeignHint arg_ty
-- The minimum amount of information needed to determine
-- the offset to apply to an argument to a foreign call.
-- See Note [Unlifted boxed arguments to foreign calls]
data StgFArgType
= StgPlainType
| StgArrayType
| StgSmallArrayType
| StgByteArrayType
-- See Note [Unlifted boxed arguments to foreign calls]
add_shim :: DynFlags -> StgFArgType -> CmmExpr -> CmmExpr
add_shim dflags ty expr = case ty of
StgPlainType -> expr
StgArrayType -> cmmOffsetB dflags expr (arrPtrsHdrSize dflags)
StgSmallArrayType -> cmmOffsetB dflags expr (smallArrPtrsHdrSize dflags)
StgByteArrayType -> cmmOffsetB dflags expr (arrWordsHdrSize dflags)
-- From a function, extract information needed to determine
-- the offset of each argument when used as a C FFI argument.
-- See Note [Unlifted boxed arguments to foreign calls]
collectStgFArgTypes :: Type -> [StgFArgType]
collectStgFArgTypes = go []
where
-- Skip foralls
go bs (ForAllTy _ res) = go bs res
go bs (AppTy{}) = reverse bs
go bs (TyConApp{}) = reverse bs
go bs (LitTy{}) = reverse bs
go bs (TyVarTy{}) = reverse bs
go _ (CastTy{}) = panic "myCollectTypeArgs: CastTy"
go _ (CoercionTy{}) = panic "myCollectTypeArgs: CoercionTy"
go bs (FunTy {ft_arg = arg, ft_res=res}) =
go (typeToStgFArgType arg:bs) res
-- Choose the offset based on the type. For anything other
-- than an unlifted boxed type, there is no offset.
-- See Note [Unlifted boxed arguments to foreign calls]
typeToStgFArgType :: Type -> StgFArgType
typeToStgFArgType typ
| tycon == arrayPrimTyCon = StgArrayType
| tycon == mutableArrayPrimTyCon = StgArrayType
| tycon == arrayArrayPrimTyCon = StgArrayType
| tycon == mutableArrayArrayPrimTyCon = StgArrayType
| tycon == smallArrayPrimTyCon = StgSmallArrayType
| tycon == smallMutableArrayPrimTyCon = StgSmallArrayType
| tycon == byteArrayPrimTyCon = StgByteArrayType
| tycon == mutableByteArrayPrimTyCon = StgByteArrayType
| otherwise = StgPlainType
where
tycon = tyConAppTyCon (unwrapType arg_ty)
-- should be a tycon app, since this is a foreign call
-- should be a tycon app, since this is a foreign call
tycon = tyConAppTyCon (unwrapType typ)
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
-----------------------------------------------------------------------------
......@@ -111,9 +112,7 @@ import Data.List
--------------------------------------------------------
newtype FCode a = FCode { doFCode :: CgInfoDownwards -> CgState -> (a, CgState) }
instance Functor FCode where
fmap f (FCode g) = FCode $ \i s -> case g i s of (a, s') -> (f a, s')
deriving (Functor)
instance Applicative FCode where
pure val = FCode (\_info_down state -> (val, state))
......